diff --git a/doc/tutorial/code/exercises/Ex04g.fst b/doc/tutorial/code/exercises/Ex04g.fst index a4e3d43305e..1d1f5efe91c 100644 --- a/doc/tutorial/code/exercises/Ex04g.fst +++ b/doc/tutorial/code/exercises/Ex04g.fst @@ -1,5 +1,5 @@ module Ex04g //hd-tl -val hd : l:list 'a{is_Cons l} -> Tot 'a -val tl : l:list 'a{is_Cons l} -> Tot (list 'a) +val hd : l:list 'a{Cons? l} -> Tot 'a +val tl : l:list 'a{Cons? l} -> Tot (list 'a) diff --git a/doc/tutorial/code/exercises/Ex07a.fst b/doc/tutorial/code/exercises/Ex07a.fst index b9cabf3b502..93627dc3b4a 100644 --- a/doc/tutorial/code/exercises/Ex07a.fst +++ b/doc/tutorial/code/exercises/Ex07a.fst @@ -89,8 +89,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = // by_induction_on e progress match e with | EVar y -> () @@ -119,8 +119,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -132,7 +132,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -171,11 +171,11 @@ let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> g:env -> Lemma - (requires ( is_Some (typing empty v) /\ - is_Some (typing (extend g x (Some.v (typing empty v))) e))) - (ensures (is_Some (typing empty v) /\ + (requires ( Some? (typing empty v) /\ + Some? (typing (extend g x (Some?.v (typing empty v))) e))) + (ensures (Some? (typing empty v) /\ typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e)) + typing (extend g x (Some?.v (typing empty v))) e)) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -208,8 +208,8 @@ let rec substitution_preserves_typing x e v g = val preservation : e:exp -> Lemma - (requires(is_Some (typing empty e) /\ is_Some (step e) )) - (ensures(is_Some (step e) /\ typing empty (Some.v (step e)) == typing empty e)) + (requires(Some? (typing empty e) /\ Some? (step e) )) + (ensures(Some? (step e) /\ typing empty (Some?.v (step e)) == typing empty e)) let rec preservation e = match e with | EApp e1 e2 -> @@ -225,5 +225,5 @@ let rec preservation e = else preservation e1 (* Exercise: implement this function *) -val typed_step : e:exp{is_Some (typing empty e) /\ not(is_value e)} -> +val typed_step : e:exp{Some? (typing empty e) /\ not(is_value e)} -> Tot (e':exp{typing empty e' = typing empty e}) diff --git a/doc/tutorial/code/exercises/Ex07b.fst b/doc/tutorial/code/exercises/Ex07b.fst index 27d416147da..817eaac3e50 100644 --- a/doc/tutorial/code/exercises/Ex07b.fst +++ b/doc/tutorial/code/exercises/Ex07b.fst @@ -126,8 +126,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -157,8 +157,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -170,7 +170,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -205,10 +205,10 @@ val typing_extensional : g:env -> g':env -> e:exp let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -239,8 +239,8 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e1; substitution_preserves_typing x e1 v gy) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> diff --git a/doc/tutorial/code/exercises/Ex07c.fst b/doc/tutorial/code/exercises/Ex07c.fst index 6fc516174c7..0bb458c9ecc 100644 --- a/doc/tutorial/code/exercises/Ex07c.fst +++ b/doc/tutorial/code/exercises/Ex07c.fst @@ -90,8 +90,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -120,8 +120,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -133,7 +133,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -168,10 +168,10 @@ val typing_extensional : g:env -> g':env -> e:exp let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -202,8 +202,8 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e1; substitution_preserves_typing x e1 v gy) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> diff --git a/doc/tutorial/code/exercises/Ex07d.fst b/doc/tutorial/code/exercises/Ex07d.fst index 51d84f2b1ba..8494b8fae6e 100644 --- a/doc/tutorial/code/exercises/Ex07d.fst +++ b/doc/tutorial/code/exercises/Ex07d.fst @@ -89,8 +89,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -119,8 +119,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -132,7 +132,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -167,10 +167,10 @@ val typing_extensional : g:env -> g':env -> e:exp let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -201,8 +201,8 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e1; substitution_preserves_typing x e1 v gy) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> @@ -217,10 +217,10 @@ let rec preservation e = if is_value e1 then () else preservation e1 -val typed_step : e:exp{is_Some (typing empty e) /\ not(is_value e)} -> +val typed_step : e:exp{Some? (typing empty e) /\ not(is_value e)} -> Tot (e':exp{typing empty e' = typing empty e}) -let typed_step e = progress e; preservation e; Some.v (step e) +let typed_step e = progress e; preservation e; Some?.v (step e) (* Exercise: implement this function *) -val eval : e:exp{is_Some (typing empty e)} -> +val eval : e:exp{Some? (typing empty e)} -> Dv (v:exp{is_value v && typing empty v = typing empty e}) diff --git a/doc/tutorial/code/exercises/Ex10a.fst b/doc/tutorial/code/exercises/Ex10a.fst index 7f6a965f834..3b215f6ea5a 100644 --- a/doc/tutorial/code/exercises/Ex10a.fst +++ b/doc/tutorial/code/exercises/Ex10a.fst @@ -15,11 +15,11 @@ type db = list entry (* We define two pure functions that test whether the suitable permission exists in some db *) let canWrite db file = - is_Some (tryFind (function Writable x -> x=file | _ -> false) db) + Some? (tryFind (function Writable x -> x=file | _ -> false) db) let canRead db file = - is_Some (tryFind (function Readable x | Writable x -> x=file) db) + Some? (tryFind (function Readable x | Writable x -> x=file) db) (* The acls reference stores the current access-control list, initially empty *) val acls: ref db diff --git a/doc/tutorial/code/exercises/Ex10b.fst b/doc/tutorial/code/exercises/Ex10b.fst index 73cd435874e..bded8f0f372 100644 --- a/doc/tutorial/code/exercises/Ex10b.fst +++ b/doc/tutorial/code/exercises/Ex10b.fst @@ -11,31 +11,31 @@ val new_point: x:int -> y:int -> ST point (requires (fun h -> True)) (ensures (fun h0 p h1 -> modifies TSet.empty h0 h1 - /\ fresh (Point.x p ^+^ Point.y p) h0 h1 - /\ Heap.sel h1 (Point.x p) = x - /\ Heap.sel h1 (Point.y p) = y)) + /\ fresh (Point?.x p ^+^ Point?.y p) h0 h1 + /\ Heap.sel h1 (Point?.x p) = x + /\ Heap.sel h1 (Point?.y p) = y)) let new_point x y = let x = alloc x in let y = alloc y in Point x y let shift_x p = - Point.x p := !(Point.x p) + 1 + Point?.x p := !(Point?.x p) + 1 // BEGIN: ShiftXP1Spec val shift_x_p1: p1:point - -> p2:point{ Point.x p2 <> Point.x p1 - /\ Point.y p2 <> Point.x p1 } + -> p2:point{ Point?.x p2 <> Point?.x p1 + /\ Point?.y p2 <> Point?.x p1 } -> ST unit - (requires (fun h -> Heap.contains h (Point.x p2) - /\ Heap.contains h (Point.y p2))) - (ensures (fun h0 _ h1 -> modifies (only (Point.x p1)) h0 h1)) + (requires (fun h -> Heap.contains h (Point?.x p2) + /\ Heap.contains h (Point?.y p2))) + (ensures (fun h0 _ h1 -> modifies (only (Point?.x p1)) h0 h1)) // END: ShiftXP1Spec let shift_x_p1 p1 p2 = - let p2_0 = !(Point.x p2), !(Point.y p2) in //p2 is initially p2_0 + let p2_0 = !(Point?.x p2), !(Point?.y p2) in //p2 is initially p2_0 shift_x p1; - let p2_1 = !(Point.x p2), !(Point.y p2) in + let p2_1 = !(Point?.x p2), !(Point?.y p2) in admit(); //fix the precondition and remove the admit assert (p2_0 = p2_1) //p2 is unchanged @@ -43,9 +43,9 @@ let shift_x_p1 p1 p2 = val test: unit -> St unit let test () = let p1 = new_point 0 0 in - recall (Point.x p1); - recall (Point.y p1); + recall (Point?.x p1); + recall (Point?.y p1); let p2 = new_point 0 1 in - recall (Point.x p2); - recall (Point.y p2); + recall (Point?.x p2); + recall (Point?.y p2); shift_x_p1 p1 p2 diff --git a/doc/tutorial/code/exercises/Ex11a.fst b/doc/tutorial/code/exercises/Ex11a.fst index b3af00559a0..dba14077d77 100644 --- a/doc/tutorial/code/exercises/Ex11a.fst +++ b/doc/tutorial/code/exercises/Ex11a.fst @@ -33,28 +33,28 @@ type arm = type bot = | Bot : #r:rid - -> pos :point{includes r (Point.r pos)} - -> left :arm {includes r (Arm.r left)} - -> right:arm {includes r (Arm.r right) - /\ disjoint (Point.r pos) (Arm.r left) - /\ disjoint (Point.r pos) (Arm.r right) - /\ disjoint (Arm.r left) (Arm.r right)} + -> pos :point{includes r (Point?.r pos)} + -> left :arm {includes r (Arm?.r left)} + -> right:arm {includes r (Arm?.r right) + /\ disjoint (Point?.r pos) (Arm?.r left) + /\ disjoint (Point?.r pos) (Arm?.r right) + /\ disjoint (Arm?.r left) (Arm?.r right)} -> bot // END: Types // BEGIN: Invariant let flying (b:bot) (h:HyperHeap.t) = - sel h (Point.z (Bot.pos b)) > 0 + sel h (Point?.z (Bot?.pos b)) > 0 let arms_up (b:bot) (h:HyperHeap.t) = - sel h (Arm.polar (Bot.right b)) = 0 - /\ sel h (Arm.polar (Bot.left b)) = 0 + sel h (Arm?.polar (Bot?.right b)) = 0 + /\ sel h (Arm?.polar (Bot?.left b)) = 0 type robot_inv (b:bot) (h:HyperHeap.t) = - Map.contains h (Bot.r b) - /\ Map.contains h (Point.r (Bot.pos b)) - /\ Map.contains h (Arm.r (Bot.left b)) - /\ Map.contains h (Arm.r (Bot.right b)) + Map.contains h (Bot?.r b) + /\ Map.contains h (Point?.r (Bot?.pos b)) + /\ Map.contains h (Arm?.r (Bot?.left b)) + /\ Map.contains h (Arm?.r (Bot?.right b)) /\ (flying b h ==> arms_up b h) // END: Invariant @@ -63,11 +63,11 @@ val new_point: r0:rid -> x:int -> y:int -> z:int -> ST point (requires (fun h0 -> True)) (ensures (fun h0 p h1 -> modifies empty h0 h1 - /\ extends (Point.r p) r0 - /\ fresh_region (Point.r p) h0 h1 - /\ sel h1 (Point.x p) = x - /\ sel h1 (Point.y p) = y - /\ sel h1 (Point.z p) = z)) + /\ extends (Point?.r p) r0 + /\ fresh_region (Point?.r p) h0 h1 + /\ sel h1 (Point?.x p) = x + /\ sel h1 (Point?.y p) = y + /\ sel h1 (Point?.z p) = z)) let new_point r0 x y z = let r = new_region r0 in let x = ralloc r x in @@ -79,8 +79,8 @@ val new_arm: r0:rid -> ST arm (requires (fun h0 -> True)) (ensures (fun h0 x h1 -> modifies empty h0 h1 - /\ extends (Arm.r x) r0 - /\ fresh_region (Arm.r x) h0 h1)) + /\ extends (Arm?.r x) r0 + /\ fresh_region (Arm?.r x) h0 h1)) let new_arm r0 = let r = new_region r0 in let p = ralloc r 0 in @@ -91,8 +91,8 @@ val new_robot: r0:rid -> ST bot (requires (fun h0 -> True)) (ensures (fun h0 x h1 -> modifies empty h0 h1 - /\ extends (Bot.r x) r0 - /\ fresh_region (Bot.r x) h0 h1 + /\ extends (Bot?.r x) r0 + /\ fresh_region (Bot?.r x) h0 h1 /\ robot_inv x h1)) let new_robot r0 = let r = new_region r0 in @@ -105,35 +105,35 @@ let new_robot r0 = val walk_robot_to: x:int -> y:int -> b:bot -> ST unit (requires (robot_inv b)) (ensures (fun h0 u h1 -> - modifies (only (Point.r (Bot.pos b))) h0 h1 + modifies (only (Point?.r (Bot?.pos b))) h0 h1 /\ robot_inv b h1 - /\ sel h1 (Point.z (Bot.pos b)) = sel h1 (Point.z (Bot.pos b)) - /\ sel h1 (Point.x (Bot.pos b)) = x - /\ sel h1 (Point.y (Bot.pos b)) = y)) + /\ sel h1 (Point?.z (Bot?.pos b)) = sel h1 (Point?.z (Bot?.pos b)) + /\ sel h1 (Point?.x (Bot?.pos b)) = x + /\ sel h1 (Point?.y (Bot?.pos b)) = y)) let walk_robot_to x y b = - Point.x (Bot.pos b) := x; - Point.y (Bot.pos b) := y + Point?.x (Bot?.pos b) := x; + Point?.y (Bot?.pos b) := y // BEGIN: Fly val fly: b:bot -> ST unit (requires (fun h -> robot_inv b h)) (ensures (fun h0 _u h1 -> - modifies (only (Bot.r b)) h0 h1 + modifies (only (Bot?.r b)) h0 h1 /\ robot_inv b h1 /\ flying b h1)) let fly b = - Arm.azim (Bot.right b) := 17; - Arm.polar (Bot.left b) := 0; - Arm.polar (Bot.right b) := 0; - Point.z (Bot.pos b) := 100 + Arm?.azim (Bot?.right b) := 17; + Arm?.polar (Bot?.left b) := 0; + Arm?.polar (Bot?.right b) := 0; + Point?.z (Bot?.pos b) := 100 // END: Fly // BEGIN: FlyBoth -val fly_both: b0:bot -> b1:bot{disjoint (Bot.r b0) (Bot.r b1)} +val fly_both: b0:bot -> b1:bot{disjoint (Bot?.r b0) (Bot?.r b1)} -> ST unit (requires (fun h -> robot_inv b0 h /\ robot_inv b1 h)) (ensures (fun h0 x h1 -> - modifies (Bot.r b0 ^+^ Bot.r b1) h0 h1 + modifies (Bot?.r b0 ^+^ Bot?.r b1) h0 h1 /\ robot_inv b0 h1 /\ robot_inv b1 h1 /\ flying b0 h1 @@ -143,10 +143,10 @@ let fly_both b0 b1 = fly b1 // END: FlyBoth -val fly_one: b0:bot -> b1:bot{disjoint (Bot.r b0) (Bot.r b1)} -> ST unit +val fly_one: b0:bot -> b1:bot{disjoint (Bot?.r b0) (Bot?.r b1)} -> ST unit (requires (fun h -> robot_inv b0 h /\ robot_inv b1 h /\ ~(flying b1 h))) (ensures (fun h0 x h1 -> - modifies (only (Bot.r b0)) h0 h1 + modifies (only (Bot?.r b0)) h0 h1 /\ robot_inv b0 h1 /\ robot_inv b1 h1 /\ flying b0 h1 @@ -157,9 +157,9 @@ let fly_one b0 b1 = noeq type bots : set rid -> Type = | Nil : bots empty | Cons : #rs:set rid - -> hd:bot{distinct (Bot.r hd) rs} + -> hd:bot{distinct (Bot?.r hd) rs} -> tl:bots rs - -> bots (rs ++^ Bot.r hd) + -> bots (rs ++^ Bot?.r hd) val mem : #rs:set rid -> bot -> bs:bots rs -> Tot bool (decreases bs) let rec mem (#rs:set rid) b = function @@ -168,7 +168,7 @@ let rec mem (#rs:set rid) b = function val lemma_mem_rid: #rs:set rid -> bs:bots rs -> b:bot -> Lemma (requires (mem #rs b bs)) - (ensures (Set.mem (Bot.r b) rs)) + (ensures (Set.mem (Bot?.r b) rs)) (decreases bs) [SMTPat (mem #rs b bs)] let rec lemma_mem_rid #rs bs b = @@ -176,10 +176,10 @@ let rec lemma_mem_rid #rs bs b = | Nil -> () | Cons hd tl -> if b <> hd then lemma_mem_rid tl b -val lemma_bots_tl_disjoint: #rs:set rid -> bs:bots rs{is_Cons bs} +val lemma_bots_tl_disjoint: #rs:set rid -> bs:bots rs{Cons? bs} -> Lemma (requires True) (ensures (forall b. let Cons hd tl = bs in - mem b tl ==> disjoint (Bot.r b) (Bot.r hd))) + mem b tl ==> disjoint (Bot?.r b) (Bot?.r hd))) let lemma_bots_tl_disjoint #rs bs = () //implement this function diff --git a/doc/tutorial/code/exercises/Ex12.MAC.fst b/doc/tutorial/code/exercises/Ex12.MAC.fst index 7a5bcf5b782..954cc50aa38 100644 --- a/doc/tutorial/code/exercises/Ex12.MAC.fst +++ b/doc/tutorial/code/exercises/Ex12.MAC.fst @@ -57,7 +57,7 @@ let verify k text tag = let m= hmac_sha1 k text in let verified = (Platform.Bytes.equalBytes m tag) in let found = - is_Some + Some? (List.Tot.find (fun (Entry k' text' tag') -> Platform.Bytes.equalBytes k k' && Platform.Bytes.equalBytes text text') !log) in diff --git a/doc/tutorial/code/exercises/Ex12g.TMAC2.fst b/doc/tutorial/code/exercises/Ex12g.TMAC2.fst index 13b5a0b788d..33011704379 100644 --- a/doc/tutorial/code/exercises/Ex12g.TMAC2.fst +++ b/doc/tutorial/code/exercises/Ex12g.TMAC2.fst @@ -22,8 +22,8 @@ assume type key_prop : key -> text2 -> Type type pkey (p:(text2 -> Type)) = k:key{ key_prop k == p - /\ BMAC.key_prop (Keys.k0 k) == bspec0 p - /\ BMAC.key_prop (Keys.k1 k) == bspec1 p } + /\ BMAC.key_prop (Keys?.k0 k) == bspec0 p + /\ BMAC.key_prop (Keys?.k1 k) == bspec1 p } val keygen: p:(text2 -> Type) -> pkey p val mac: p:(text2 -> Type) -> k:pkey p -> t:text2{p t} -> tag diff --git a/doc/tutorial/code/solutions/EtM.AE.fst b/doc/tutorial/code/solutions/EtM.AE.fst index f7b8a762690..e2a1ddca62b 100644 --- a/doc/tutorial/code/solutions/EtM.AE.fst +++ b/doc/tutorial/code/solutions/EtM.AE.fst @@ -120,8 +120,8 @@ val decrypt: k:key -> c:cipher -> ST (option Plain.plain) (ensures (fun h0 res h1 -> modifies_none h0 h1 /\ invariant h1 k /\ - ( (b2t Ideal.uf_cma /\ is_Some res) ==> - (is_Some (seq_find (fun (_,c') -> c = c') (get_log h0 k))) + ( (b2t Ideal.uf_cma /\ Some? res) ==> + (Some? (seq_find (fun (_,c') -> c = c') (get_log h0 k))) (* CH*MK: If we wanted to also prove correctness of the EtM.AE we would use this stronger post-condition: diff --git a/doc/tutorial/code/solutions/EtM.CPA.fst b/doc/tutorial/code/solutions/EtM.CPA.fst index b3f164693f8..385d65e9ee5 100644 --- a/doc/tutorial/code/solutions/EtM.CPA.fst +++ b/doc/tutorial/code/solutions/EtM.CPA.fst @@ -88,19 +88,19 @@ let encryption_injective k iv t1 t2 = correctness k iv t1; correctness k iv t2 (* this doesn't really belong here *) val mem : #a:eqtype -> x:a -> xs:Seq.seq a -> Tot bool -let mem (#a:eqtype) x xs = is_Some (SeqProperties.seq_find (fun y -> y = x) xs) +let mem (#a:eqtype) x xs = Some? (SeqProperties.seq_find (fun y -> y = x) xs) val decrypt: k:key -> c:cipher -> ST msg (requires (fun h0 -> Map.contains h0 k.region /\ (let log0 = m_sel h0 k.log in - (b2t ind_cpa_rest_adv) ==> is_Some (seq_find (fun mc -> snd mc = c) log0)))) + (b2t ind_cpa_rest_adv) ==> Some? (seq_find (fun mc -> snd mc = c) log0)))) (ensures (fun h0 res h1 -> modifies_none h0 h1 /\ ( (b2t ind_cpa_rest_adv) ==> mem (res,c) (m_sel h0 k.log) (* (let log0 = m_sel h0 k.log in *) (* let found = seq_find (fun mc -> snd mc = c) log0 in *) - (* is_Some found /\ fst (Some.v found) = res) *) + (* Some? found /\ fst (Some.v found) = res) *) ) ) ) diff --git a/doc/tutorial/code/solutions/Ex04g.fst b/doc/tutorial/code/solutions/Ex04g.fst index 6875a984ded..5e5d9d4aad7 100644 --- a/doc/tutorial/code/solutions/Ex04g.fst +++ b/doc/tutorial/code/solutions/Ex04g.fst @@ -1,12 +1,12 @@ module Ex04g //hd-tl -val hd : l:list 'a{is_Cons l} -> Tot 'a +val hd : l:list 'a{Cons? l} -> Tot 'a let hd l = match l with | h :: t -> h -val tl : l:list 'a{is_Cons l} -> Tot (list 'a) +val tl : l:list 'a{Cons? l} -> Tot (list 'a) let tl l = match l with | h :: t -> t diff --git a/doc/tutorial/code/solutions/Ex07a.fst b/doc/tutorial/code/solutions/Ex07a.fst index 22a5d820485..455d9bbcf58 100644 --- a/doc/tutorial/code/solutions/Ex07a.fst +++ b/doc/tutorial/code/solutions/Ex07a.fst @@ -89,8 +89,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = // by_induction_on e progress match e with | EVar y -> () @@ -119,8 +119,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -132,7 +132,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -171,11 +171,11 @@ let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> g:env -> Lemma - (requires ( is_Some (typing empty v) /\ - is_Some (typing (extend g x (Some.v (typing empty v))) e))) - (ensures (is_Some (typing empty v) /\ + (requires ( Some? (typing empty v) /\ + Some? (typing (extend g x (Some?.v (typing empty v))) e))) + (ensures (Some? (typing empty v) /\ typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e)) + typing (extend g x (Some?.v (typing empty v))) e)) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -208,8 +208,8 @@ let rec substitution_preserves_typing x e v g = val preservation : e:exp -> Lemma - (requires(is_Some (typing empty e) /\ is_Some (step e) )) - (ensures(is_Some (step e) /\ typing empty (Some.v (step e)) == typing empty e)) + (requires(Some? (typing empty e) /\ Some? (step e) )) + (ensures(Some? (step e) /\ typing empty (Some?.v (step e)) == typing empty e)) let rec preservation e = match e with | EApp e1 e2 -> @@ -224,6 +224,6 @@ let rec preservation e = if is_value e1 then () else preservation e1 -val typed_step : e:exp{is_Some (typing empty e) /\ not(is_value e)} -> +val typed_step : e:exp{Some? (typing empty e) /\ not(is_value e)} -> Tot (e':exp{typing empty e' = typing empty e}) -let typed_step e = progress e; preservation e; Some.v (step e) +let typed_step e = progress e; preservation e; Some?.v (step e) diff --git a/doc/tutorial/code/solutions/Ex07b.fst b/doc/tutorial/code/solutions/Ex07b.fst index 121e2e76c28..dce68eed317 100644 --- a/doc/tutorial/code/solutions/Ex07b.fst +++ b/doc/tutorial/code/solutions/Ex07b.fst @@ -138,8 +138,8 @@ let rec typing g e = | _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -174,8 +174,8 @@ let rec appears_free_in x e = | ESnd e1 -> appears_free_in x e1 val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -190,7 +190,7 @@ let rec free_in_context x e g = | ESnd e1 -> free_in_context x e1 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -234,10 +234,10 @@ let typing_extensional g g' e = context_invariance e g g' #reset-options "--z3rlimit 10" val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -278,8 +278,8 @@ let rec substitution_preserves_typing x e v g = #reset-options -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> diff --git a/doc/tutorial/code/solutions/Ex07c.fst b/doc/tutorial/code/solutions/Ex07c.fst index f463be0758d..df3514e5542 100644 --- a/doc/tutorial/code/solutions/Ex07c.fst +++ b/doc/tutorial/code/solutions/Ex07c.fst @@ -101,8 +101,8 @@ let rec typing g e = | None -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -138,8 +138,8 @@ let rec appears_free_in x e = | ELet y e1 e2 -> appears_free_in x e1 || (x <> y && appears_free_in x e2) val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -151,10 +151,10 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g | ELet y e1 e2 -> (free_in_context x e1 g; - free_in_context x e2 (extend g y (Some.v (typing g e1)))) + free_in_context x e2 (extend g y (Some?.v (typing g e1)))) val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -194,11 +194,16 @@ val typing_extensional : g:env -> g':env -> e:exp (ensures (typing g e == typing g' e)) let typing_extensional g g' e = context_invariance e g g' +(* The following proof requires raising z3's resource limits from the + default 5 to 8 (7 will fail), which is performed by the following + pragma (needed regardless of whether hints are enabled or not). *) +#set-options "--z3rlimit 8" + val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -240,8 +245,8 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e2; substitution_preserves_typing x e2 v gy)) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> diff --git a/doc/tutorial/code/solutions/Ex07c.fst.hints b/doc/tutorial/code/solutions/Ex07c.fst.hints deleted file mode 100644 index 31cbe072bfd..00000000000 --- a/doc/tutorial/code/solutions/Ex07c.fst.hints +++ /dev/null @@ -1,756 +0,0 @@ -[ - "\u000fBln&ڼ\u0010|", - [ - [ "Ex07c.ty", 1, 2, 1, [ "@query" ], 0 ], - [ - "Ex07c.TArrow._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.TArrow", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_6002ee58ac4a3ba36521a5f80706c551" - ], - 0 - ], - [ - "Ex07c.TArrow._1", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.TArrow", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_6002ee58ac4a3ba36521a5f80706c551" - ], - 0 - ], - [ - "Ex07c.exp", - 1, - 2, - 1, - [ "@query", "assumption_Ex07c.ty_haseq", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.EVar._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EVar", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_4c755f4d385c2ff31f6a59466f354126" - ], - 0 - ], - [ - "Ex07c.EApp._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EApp", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_367bf44cd20cfd73c6dd058418114302" - ], - 0 - ], - [ - "Ex07c.EApp._1", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EApp", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_367bf44cd20cfd73c6dd058418114302" - ], - 0 - ], - [ - "Ex07c.EAbs._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EAbs", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_ef1d716e229ef53b68e1c770b1c1064a" - ], - 0 - ], - [ - "Ex07c.EAbs._1", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EAbs", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_ef1d716e229ef53b68e1c770b1c1064a" - ], - 0 - ], - [ - "Ex07c.EAbs._2", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EAbs", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_ef1d716e229ef53b68e1c770b1c1064a" - ], - 0 - ], - [ - "Ex07c.EIf._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EIf", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_db78324944fee4de5251460f044f2515" - ], - 0 - ], - [ - "Ex07c.EIf._1", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EIf", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_db78324944fee4de5251460f044f2515" - ], - 0 - ], - [ - "Ex07c.EIf._2", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.EIf", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_db78324944fee4de5251460f044f2515" - ], - 0 - ], - [ - "Ex07c.ELet._0", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.ELet", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_b89b9c3ef5154d39bee811eb35f85a2f" - ], - 0 - ], - [ - "Ex07c.ELet._1", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.ELet", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_b89b9c3ef5154d39bee811eb35f85a2f" - ], - 0 - ], - [ - "Ex07c.ELet._2", - 1, - 2, - 1, - [ - "@query", "disc_equation_Ex07c.ELet", - "projection_inverse_BoxBool_proj_0", - "refinement_interpretation_Tm_refine_b89b9c3ef5154d39bee811eb35f85a2f" - ], - 0 - ], - [ "Ex07c.is_value", 1, 2, 1, [ "@query" ], 0 ], - [ - "Ex07c.subst", - 1, - 2, - 1, - [ - "@query", "binder_x_6d0180d4fcd10237cf0d87dd345d77cc_0", - "binder_x_92b24ade2624a8307d6221bab881006c_2", - "constructor_distinct_Ex07c.EAbs", "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.EVar", - "disc_equation_Ex07c.EAbs", "disc_equation_Ex07c.EApp", - "disc_equation_Ex07c.EFalse", "disc_equation_Ex07c.EIf", - "disc_equation_Ex07c.ELet", "disc_equation_Ex07c.ETrue", - "disc_equation_Ex07c.EVar", "equality_tok_Ex07c.EFalse@tok", - "equality_tok_Ex07c.ETrue@tok", "equality_tok_Prims.LexTop@tok", - "fuel_guarded_inversion_Ex07c.exp", "int_inversion", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", "subterm_ordering_Ex07c.EAbs", - "subterm_ordering_Ex07c.EApp", "subterm_ordering_Ex07c.EIf", - "subterm_ordering_Ex07c.ELet" - ], - 0 - ], - [ "Ex07c.subst", 2, 2, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "Ex07c.subst", 3, 2, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "Ex07c.subst", 4, 2, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ - "Ex07c.step", - 1, - 2, - 1, - [ - "@query", "binder_x_92b24ade2624a8307d6221bab881006c_0", - "bool_inversion", "disc_equation_Prims.None", - "disc_equation_Prims.Some", "kinding_Ex07c.exp@tok", - "lemma_Prims.invertOption", "projection_inverse_BoxBool_proj_0", - "subterm_ordering_Ex07c.EApp", "subterm_ordering_Ex07c.EIf", - "subterm_ordering_Ex07c.ELet", "typing_Prims.is_None", - "typing_Prims.is_Some" - ], - 0 - ], - [ "Ex07c.extend", 1, 2, 1, [ "@query" ], 0 ], - [ - "Ex07c.extend", - 2, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.typing", - 1, - 2, - 1, - [ - "@query", "binder_x_92b24ade2624a8307d6221bab881006c_1", - "bool_inversion", "constructor_distinct_Ex07c.EAbs", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.ELet", - "disc_equation_Ex07c.EAbs", "disc_equation_Ex07c.EApp", - "disc_equation_Ex07c.EFalse", "disc_equation_Ex07c.EIf", - "disc_equation_Ex07c.ELet", "disc_equation_Ex07c.ETrue", - "disc_equation_Ex07c.EVar", "fuel_guarded_inversion_Ex07c.exp", - "kinding_Ex07c.ty@tok", "lemma_Prims.invertOption", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Prims.Mktuple3__2", - "subterm_ordering_Ex07c.EAbs", "subterm_ordering_Ex07c.EApp", - "subterm_ordering_Ex07c.EIf", "subterm_ordering_Ex07c.ELet", - "typing_Prims.is_None", "typing_Prims.is_Some" - ], - 0 - ], - [ "Ex07c.typing", 2, 2, 1, [ "@query", "assumption_Ex07c.ty_haseq" ], 0 ], - [ "Ex07c.typing", 3, 2, 1, [ "@query", "assumption_Ex07c.ty_haseq" ], 0 ], - [ - "Ex07c.progress", - 1, - 2, - 1, - [ - "@query", "binder_x_92b24ade2624a8307d6221bab881006c_0", - "bool_inversion", "bool_typing", "constructor_distinct_Ex07c.EAbs", - "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EFalse", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.ELet", - "constructor_distinct_Ex07c.ETrue", - "constructor_distinct_Ex07c.EVar", - "constructor_distinct_Ex07c.TArrow", - "constructor_distinct_Ex07c.TBool", - "constructor_distinct_Prims.Mktuple2", - "constructor_distinct_Prims.None", "constructor_distinct_Prims.Some", - "constructor_distinct_Tm_unit", "data_elim_Prims.None", - "data_elim_Prims.Some", "data_typing_intro_Ex07c.ETrue@tok", - "disc_equation_Ex07c.EAbs", "disc_equation_Ex07c.EApp", - "disc_equation_Ex07c.EFalse", "disc_equation_Ex07c.EIf", - "disc_equation_Ex07c.ELet", "disc_equation_Ex07c.ETrue", - "disc_equation_Ex07c.EVar", "disc_equation_Prims.None", - "disc_equation_Prims.Some", "equality_tok_Ex07c.EFalse@tok", - "equality_tok_Ex07c.ETrue@tok", "equality_tok_Ex07c.TBool@tok", - "equation_Ex07c.empty", "equation_Ex07c.env", - "equation_Ex07c.is_value", - "equation_with_fuel_Ex07c.step.fuel_instrumented", - "equation_with_fuel_Ex07c.typing.fuel_instrumented", - "fuel_correspondence_Ex07c.step.fuel_instrumented", - "fuel_correspondence_Ex07c.typing.fuel_instrumented", - "fuel_guarded_inversion_Ex07c.exp", - "fuel_guarded_inversion_Prims.option", - "fuel_irrelevance_Ex07c.step.fuel_instrumented", - "fuel_irrelevance_Ex07c.typing.fuel_instrumented", - "function_token_typing_Ex07c.empty", "kinding_Ex07c.exp@tok", - "kinding_Ex07c.ty@tok", "lemma_Prims.invertOption", - "pretyping_5c69a0eb92c7f94e44012145da40d8d2", - "pretyping_92b24ade2624a8307d6221bab881006c", - "proj_equation_Prims.Mktuple2__1", "proj_equation_Prims.Mktuple2__2", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EApp__0", - "projection_inverse_Ex07c.EApp__1", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", - "projection_inverse_Ex07c.EVar__0", - "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", - "projection_inverse_Prims.Mktuple3__1", - "projection_inverse_Prims.Mktuple3__2", - "projection_inverse_Prims.Mktuple3__3", - "projection_inverse_Prims.Some_a", "projection_inverse_Prims.Some_v", - "subterm_ordering_Ex07c.EAbs", "subterm_ordering_Ex07c.EApp", - "subterm_ordering_Ex07c.EIf", "subterm_ordering_Ex07c.ELet", - "token_correspondence_Ex07c.empty", - "token_correspondence_Ex07c.typing.fuel_instrumented", - "typing_Ex07c.is_value", "typing_Ex07c.step", "typing_Ex07c.typing", - "typing_Prims.is_None", "typing_Prims.is_Some", - "typing_tok_Ex07c.TBool@tok", "unit_inversion", "unit_typing" - ], - 0 - ], - [ - "Ex07c.appears_free_in", - 1, - 2, - 1, - [ - "@query", "binder_x_6d0180d4fcd10237cf0d87dd345d77cc_0", - "binder_x_92b24ade2624a8307d6221bab881006c_1", - "constructor_distinct_Ex07c.EAbs", "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EIf", "disc_equation_Ex07c.EAbs", - "disc_equation_Ex07c.EApp", "disc_equation_Ex07c.EFalse", - "disc_equation_Ex07c.EIf", "disc_equation_Ex07c.ELet", - "disc_equation_Ex07c.ETrue", "disc_equation_Ex07c.EVar", - "equality_tok_Prims.LexTop@tok", "fuel_guarded_inversion_Ex07c.exp", - "int_inversion", "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", "subterm_ordering_Ex07c.EAbs", - "subterm_ordering_Ex07c.EApp", "subterm_ordering_Ex07c.EIf", - "subterm_ordering_Ex07c.ELet" - ], - 0 - ], - [ - "Ex07c.appears_free_in", - 2, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.appears_free_in", - 3, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.appears_free_in", - 4, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.free_in_context", - 1, - 2, - 1, - [ - "@query", "binder_x_6a3cb483d6204d3c1e0662b0f94ffbd3_2", - "binder_x_6d0180d4fcd10237cf0d87dd345d77cc_0", - "binder_x_92b24ade2624a8307d6221bab881006c_1", "bool_inversion", - "constructor_distinct_Ex07c.EAbs", "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EFalse", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.ETrue", - "constructor_distinct_Ex07c.EVar", - "constructor_distinct_Prims.Mktuple2", - "constructor_distinct_Prims.Mktuple3", - "constructor_distinct_Prims.None", "data_elim_Prims.None", - "data_elim_Prims.Some", "disc_equation_Ex07c.EAbs", - "disc_equation_Ex07c.EApp", "disc_equation_Ex07c.EFalse", - "disc_equation_Ex07c.EIf", "disc_equation_Ex07c.ELet", - "disc_equation_Ex07c.ETrue", "disc_equation_Ex07c.EVar", - "disc_equation_Prims.None", "disc_equation_Prims.Some", - "equality_tok_Ex07c.EFalse@tok", "equality_tok_Ex07c.ETrue@tok", - "equality_tok_Prims.LexTop@tok", "equation_Ex07c.env", - "equation_Ex07c.extend", - "equation_with_fuel_Ex07c.appears_free_in.fuel_instrumented", - "equation_with_fuel_Ex07c.typing.fuel_instrumented", - "fuel_correspondence_Ex07c.appears_free_in.fuel_instrumented", - "fuel_correspondence_Ex07c.typing.fuel_instrumented", - "fuel_guarded_inversion_Ex07c.exp", - "fuel_irrelevance_Ex07c.appears_free_in.fuel_instrumented", - "fuel_irrelevance_Ex07c.typing.fuel_instrumented", "int_inversion", - "interpretation_Tm_abs_abbfb54e2ab7bf3bbeab7bca2280098d", - "interpretation_Tm_arrow_316ff88bcf9642f15cdd4319970d3873", - "kinding_Ex07c.ty@tok", "lemma_Prims.invertOption", - "pretyping_ae567c2fb75be05905677af440075565", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Equality", "primitive_Prims.op_disEquality", - "proj_equation_Prims.Some_v", "projection_inverse_BoxBool_proj_0", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EApp__0", - "projection_inverse_Ex07c.EApp__1", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Ex07c.ELet__0", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", - "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", - "projection_inverse_Prims.Mktuple3__1", - "projection_inverse_Prims.Mktuple3__2", - "projection_inverse_Prims.Mktuple3__3", - "projection_inverse_Prims.Mktuple3__a", - "projection_inverse_Prims.Mktuple3__b", - "projection_inverse_Prims.Mktuple3__c", - "subterm_ordering_Ex07c.EAbs", "subterm_ordering_Ex07c.EApp", - "subterm_ordering_Ex07c.EIf", "subterm_ordering_Ex07c.ELet", - "token_correspondence_Ex07c.appears_free_in.fuel_instrumented", - "token_correspondence_Ex07c.extend", - "token_correspondence_Ex07c.typing.fuel_instrumented", - "typing_Ex07c.appears_free_in", "typing_Ex07c.extend", - "typing_Ex07c.typing", "typing_Prims.is_Some", "unit_typing" - ], - 0 - ], - [ - "Ex07c.typable_empty_closed", - 1, - 2, - 1, - [ - "@query", "constructor_distinct_Prims.None", - "disc_equation_Prims.Some", "equality_tok_Ex07c.TBool@tok", - "equation_Ex07c.empty", "int_inversion", - "pretyping_5c69a0eb92c7f94e44012145da40d8d2", - "projection_inverse_BoxBool_proj_0", "typing_tok_Ex07c.TBool@tok", - "unit_inversion", "unit_typing" - ], - 0 - ], - [ - "Ex07c.equal", - 1, - 2, - 1, - [ - "@query", "assumption_Ex07c.ty_haseq", - "assumption_Prims.option_haseq", "kinding_Ex07c.ty@tok" - ], - 0 - ], - [ - "Ex07c.equalE", - 1, - 2, - 1, - [ - "@query", "assumption_Ex07c.ty_haseq", - "assumption_Prims.option_haseq", "kinding_Ex07c.ty@tok" - ], - 0 - ], - [ - "Ex07c.context_invariance", - 1, - 2, - 1, - [ - "@query", "binder_x_6a3cb483d6204d3c1e0662b0f94ffbd3_1", - "binder_x_6a3cb483d6204d3c1e0662b0f94ffbd3_2", - "binder_x_92b24ade2624a8307d6221bab881006c_0", "bool_inversion", - "constructor_distinct_Ex07c.EAbs", "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.ELet", - "constructor_distinct_Ex07c.ETrue", - "constructor_distinct_Ex07c.TBool", - "constructor_distinct_Prims.None", "constructor_distinct_Prims.Some", - "constructor_distinct_Prims.option", - "constructor_distinct_Prims.unit", "constructor_distinct_Tm_unit", - "data_elim_Ex07c.EVar", "disc_equation_Ex07c.EAbs", - "disc_equation_Ex07c.EApp", "disc_equation_Ex07c.EIf", - "disc_equation_Ex07c.ELet", "disc_equation_Prims.Some", - "equality_tok_Ex07c.TBool@tok", "equation_Ex07c.equalE", - "equation_Ex07c.extend", - "equation_with_fuel_Ex07c.appears_free_in.fuel_instrumented", - "equation_with_fuel_Ex07c.typing.fuel_instrumented", - "fuel_correspondence_Ex07c.appears_free_in.fuel_instrumented", - "fuel_correspondence_Ex07c.typing.fuel_instrumented", - "fuel_guarded_inversion_Ex07c.exp", - "fuel_guarded_inversion_Prims.option", - "fuel_irrelevance_Ex07c.appears_free_in.fuel_instrumented", - "fuel_irrelevance_Ex07c.typing.fuel_instrumented", "int_inversion", - "int_typing", - "interpretation_Tm_abs_abbfb54e2ab7bf3bbeab7bca2280098d", - "kinding_Ex07c.ty@tok", "lemma_Ex07c.typable_empty_closed", - "lemma_Prims.invertOption", - "pretyping_5c69a0eb92c7f94e44012145da40d8d2", - "pretyping_779086306c29597e3dd1127d16405da1", - "pretyping_ae567c2fb75be05905677af440075565", - "pretyping_f8666440faa91836cc5a13998af863fc", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Equality", "primitive_Prims.op_disEquality", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EApp__0", - "projection_inverse_Ex07c.EApp__1", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Ex07c.ELet__0", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", - "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple3__1", - "projection_inverse_Prims.Mktuple3__2", - "projection_inverse_Prims.Mktuple3__3", - "projection_inverse_Prims.None_a", "projection_inverse_Prims.Some_v", - "subterm_ordering_Ex07c.EAbs", "subterm_ordering_Ex07c.EApp", - "subterm_ordering_Ex07c.EIf", "subterm_ordering_Ex07c.ELet", - "typing_Ex07c.appears_free_in", "typing_Ex07c.extend", - "typing_Ex07c.typing", "typing_Prims.is_None", - "typing_tok_Ex07c.TBool@tok", "unit_inversion", "unit_typing" - ], - 0 - ], - [ - "Ex07c.typing_extensional", - 1, - 2, - 1, - [ "@query", "equation_Ex07c.equal", "equation_Ex07c.equalE" ], - 0 - ], - [ - "Ex07c.substitution_preserves_typing", - 1, - 2, - 1, - [ - "@query", "equation_Ex07c.env", - "refinement_interpretation_Tm_refine_8e282b28ad987dffeb0bff7c6fbe2f0b" - ], - 0 - ], - [ - "Ex07c.substitution_preserves_typing", - 2, - 1, - 1, - [ - "@query", "binder_x_6d0180d4fcd10237cf0d87dd345d77cc_0", - "binder_x_90bb6eeb855dd52e1d7b52e4c67e1393_3", - "binder_x_92b24ade2624a8307d6221bab881006c_1", - "binder_x_92b24ade2624a8307d6221bab881006c_2", "bool_inversion", - "bool_typing", "constructor_distinct_Ex07c.EAbs", - "constructor_distinct_Ex07c.EApp", - "constructor_distinct_Ex07c.EFalse", - "constructor_distinct_Ex07c.EIf", "constructor_distinct_Ex07c.ELet", - "constructor_distinct_Ex07c.ETrue", - "constructor_distinct_Ex07c.EVar", - "constructor_distinct_Ex07c.TBool", - "constructor_distinct_Prims.Mktuple3", - "constructor_distinct_Prims.None", "constructor_distinct_Prims.Some", - "constructor_distinct_Tm_unit", "data_elim_Prims.None", - "data_elim_Prims.Some", "disc_equation_Ex07c.EAbs", - "disc_equation_Ex07c.EApp", "disc_equation_Ex07c.EFalse", - "disc_equation_Ex07c.EIf", "disc_equation_Ex07c.ELet", - "disc_equation_Ex07c.ETrue", "disc_equation_Ex07c.EVar", - "disc_equation_Prims.None", "disc_equation_Prims.Some", - "equality_tok_Ex07c.EFalse@tok", "equality_tok_Ex07c.ETrue@tok", - "equality_tok_Ex07c.TBool@tok", "equation_Ex07c.empty", - "equation_Ex07c.env", "equation_Ex07c.equal", - "equation_Ex07c.equalE", "equation_Ex07c.extend", - "equation_with_fuel_Ex07c.appears_free_in.fuel_instrumented", - "equation_with_fuel_Ex07c.subst.fuel_instrumented", - "equation_with_fuel_Ex07c.typing.fuel_instrumented", - "fuel_correspondence_Ex07c.appears_free_in.fuel_instrumented", - "fuel_correspondence_Ex07c.subst.fuel_instrumented", - "fuel_correspondence_Ex07c.typing.fuel_instrumented", - "fuel_guarded_inversion_Ex07c.exp", - "fuel_irrelevance_Ex07c.subst.fuel_instrumented", - "fuel_irrelevance_Ex07c.typing.fuel_instrumented", - "function_token_typing_Ex07c.empty", "int_inversion", - "interpretation_Tm_abs_abbfb54e2ab7bf3bbeab7bca2280098d", - "kinding_Ex07c.ty@tok", "lemma_Ex07c.typable_empty_closed", - "lemma_Prims.invertOption", - "pretyping_5c69a0eb92c7f94e44012145da40d8d2", - "pretyping_ae567c2fb75be05905677af440075565", - "pretyping_f8666440faa91836cc5a13998af863fc", - "primitive_Prims.op_Equality", "proj_equation_Prims.Some_v", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EApp__0", - "projection_inverse_Ex07c.EApp__1", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Ex07c.ELet__0", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", - "projection_inverse_Ex07c.EVar__0", - "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", - "projection_inverse_Prims.Mktuple3__1", - "projection_inverse_Prims.Mktuple3__2", - "projection_inverse_Prims.Mktuple3__3", - "projection_inverse_Prims.Mktuple3__a", - "projection_inverse_Prims.Mktuple3__b", - "projection_inverse_Prims.Mktuple3__c", - "projection_inverse_Prims.Some_a", "projection_inverse_Prims.Some_v", - "refinement_interpretation_Tm_refine_0a5e383e418fdd5bae77b7355b5a1834", - "refinement_interpretation_Tm_refine_27c51304280fb01f510923c5e6ddc6ed", - "refinement_interpretation_Tm_refine_97510c82b05f646a0e91f9ec518e6b6c", - "subterm_ordering_Ex07c.EAbs", "subterm_ordering_Ex07c.EApp", - "subterm_ordering_Ex07c.EIf", "subterm_ordering_Ex07c.ELet", - "token_correspondence_Ex07c.empty", - "token_correspondence_Ex07c.typing.fuel_instrumented", - "typing_Ex07c.appears_free_in", "typing_Ex07c.typing", - "typing_Tm_abs_abbfb54e2ab7bf3bbeab7bca2280098d", - "typing_tok_Ex07c.TBool@tok", "unit_inversion", "unit_typing" - ], - 0 - ], - [ - "Ex07c.substitution_preserves_typing", - 3, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.substitution_preserves_typing", - 4, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.substitution_preserves_typing", - 5, - 2, - 1, - [ "@query", "assumption_Prims.HasEq_int" ], - 0 - ], - [ - "Ex07c.preservation", - 1, - 2, - 1, - [ - "@query", - "refinement_interpretation_Tm_refine_262bb28355b5e134278f7497edd95a11" - ], - 0 - ], - [ - "Ex07c.preservation", - 2, - 2, - 1, - [ - "@query", "binder_x_49e2ba9ddb3469c0c6d9cc5cd661efad_0", - "constructor_distinct_Ex07c.EApp", "constructor_distinct_Ex07c.EIf", - "constructor_distinct_Ex07c.ELet", - "constructor_distinct_Ex07c.TBool", - "constructor_distinct_Prims.Mktuple2", - "constructor_distinct_Prims.Mktuple3", - "constructor_distinct_Prims.None", - "constructor_distinct_Prims.option", - "constructor_distinct_Prims.unit", "constructor_distinct_Tm_unit", - "data_elim_Prims.None", "data_elim_Prims.Some", - "data_typing_intro_Ex07c.ETrue@tok", "disc_equation_Ex07c.EAbs", - "disc_equation_Ex07c.EApp", "disc_equation_Ex07c.EIf", - "disc_equation_Ex07c.ELet", "disc_equation_Prims.None", - "disc_equation_Prims.Some", "equality_tok_Ex07c.TBool@tok", - "equation_Ex07c.empty", "equation_Ex07c.env", - "equation_Ex07c.extend", "equation_Ex07c.is_value", - "equation_with_fuel_Ex07c.step.fuel_instrumented", - "equation_with_fuel_Ex07c.typing.fuel_instrumented", - "fuel_correspondence_Ex07c.step.fuel_instrumented", - "fuel_correspondence_Ex07c.typing.fuel_instrumented", - "fuel_guarded_inversion_Ex07c.exp", - "fuel_guarded_inversion_Prims.option", - "fuel_irrelevance_Ex07c.step.fuel_instrumented", - "fuel_irrelevance_Ex07c.typing.fuel_instrumented", - "function_token_typing_Ex07c.empty", "int_inversion", - "kinding_Ex07c.exp@tok", "lemma_Prims.invertOption", - "pretyping_5c69a0eb92c7f94e44012145da40d8d2", - "pretyping_779086306c29597e3dd1127d16405da1", - "pretyping_92b24ade2624a8307d6221bab881006c", - "pretyping_f8666440faa91836cc5a13998af863fc", - "primitive_Prims.op_Equality", "proj_equation_Prims.Some_v", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_Ex07c.EAbs__0", - "projection_inverse_Ex07c.EAbs__1", - "projection_inverse_Ex07c.EAbs__2", - "projection_inverse_Ex07c.EApp__0", - "projection_inverse_Ex07c.EApp__1", - "projection_inverse_Ex07c.EIf__0", "projection_inverse_Ex07c.EIf__1", - "projection_inverse_Ex07c.EIf__2", - "projection_inverse_Ex07c.ELet__0", - "projection_inverse_Ex07c.ELet__1", - "projection_inverse_Ex07c.ELet__2", - "projection_inverse_Ex07c.TArrow__0", - "projection_inverse_Ex07c.TArrow__1", - "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", - "projection_inverse_Prims.Mktuple3__1", - "projection_inverse_Prims.Mktuple3__2", - "projection_inverse_Prims.Mktuple3__3", - "projection_inverse_Prims.Mktuple3__a", - "projection_inverse_Prims.Mktuple3__b", - "projection_inverse_Prims.Mktuple3__c", - "projection_inverse_Prims.Some_v", - "refinement_interpretation_Tm_refine_08a0d2041cdbb5881203d189cedd63d5", - "refinement_interpretation_Tm_refine_262bb28355b5e134278f7497edd95a11", - "refinement_interpretation_Tm_refine_5f8e12c3c9dc989dce584ea2c13d037b", - "refinement_interpretation_Tm_refine_a65d061d83203b1cacbe740a73e71d8f", - "subterm_ordering_Ex07c.EApp", "subterm_ordering_Ex07c.EIf", - "subterm_ordering_Ex07c.ELet", "token_correspondence_Ex07c.empty", - "token_correspondence_Ex07c.step.fuel_instrumented", - "token_correspondence_Ex07c.typing.fuel_instrumented", - "typing_Ex07c.extend", "typing_Ex07c.step", "typing_Ex07c.typing", - "typing_Tm_abs_abbfb54e2ab7bf3bbeab7bca2280098d", - "typing_tok_Ex07c.TBool@tok", "unit_inversion", "unit_typing" - ], - 0 - ] - ] -] \ No newline at end of file diff --git a/doc/tutorial/code/solutions/Ex07d.fst b/doc/tutorial/code/solutions/Ex07d.fst index a82776708df..442acf1f89e 100644 --- a/doc/tutorial/code/solutions/Ex07d.fst +++ b/doc/tutorial/code/solutions/Ex07d.fst @@ -89,8 +89,8 @@ let rec typing g e = | _ , _ , _ -> None) val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = match e with | EVar y -> () @@ -119,8 +119,8 @@ let rec appears_free_in x e = | EFalse -> false val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -132,7 +132,7 @@ let rec free_in_context x e g = free_in_context x e2 g; free_in_context x e3 g val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -167,10 +167,10 @@ val typing_extensional : g:env -> g':env -> e:exp let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some?.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == - typing (extend g x (Some.v (typing empty v))) e}) + typing (extend g x (Some?.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = let Some t_x = typing empty v in let gx = extend g x t_x in @@ -201,8 +201,8 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e1; substitution_preserves_typing x e1 v gy) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> - Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> + Tot (u:unit{typing empty (Some?.v (step e)) == typing empty e}) let rec preservation e = match e with | EApp e1 e2 -> @@ -217,17 +217,17 @@ let rec preservation e = if is_value e1 then () else preservation e1 -val typed_step : e:exp{is_Some (typing empty e) /\ not(is_value e)} -> +val typed_step : e:exp{Some? (typing empty e) /\ not(is_value e)} -> Tot (e':exp{typing empty e' = typing empty e}) -let typed_step e = progress e; preservation e; Some.v (step e) +let typed_step e = progress e; preservation e; Some?.v (step e) -val eval : e:exp{is_Some (typing empty e)} -> +val eval : e:exp{Some? (typing empty e)} -> Dv (v:exp{is_value v && typing empty v = typing empty e}) let rec eval e = if is_value e then e else eval (typed_step e) -val eval' : e:exp{is_Some (typing empty e)} -> +val eval' : e:exp{Some? (typing empty e)} -> Dv (v:exp{is_value v && typing empty v = typing empty e}) let rec eval' e = let Some t = typing empty e in diff --git a/doc/tutorial/code/solutions/Ex10a.fst b/doc/tutorial/code/solutions/Ex10a.fst index 86f6cd074f2..00e949b1a4c 100644 --- a/doc/tutorial/code/solutions/Ex10a.fst +++ b/doc/tutorial/code/solutions/Ex10a.fst @@ -15,11 +15,11 @@ type db = list entry (* We define two pure functions that test whether the suitable permission exists in some db *) let canWrite db file = - is_Some (tryFind (function Writable x -> x=file | _ -> false) db) + Some? (tryFind (function Writable x -> x=file | _ -> false) db) let canRead db file = - is_Some (tryFind (function Readable x | Writable x -> x=file) db) + Some? (tryFind (function Readable x | Writable x -> x=file) db) (* The acls reference stores the current access-control list, initially empty *) val acls: ref db diff --git a/doc/tutorial/code/solutions/Ex10b.fst b/doc/tutorial/code/solutions/Ex10b.fst index 6bdd8c204b6..7a4ec34b014 100644 --- a/doc/tutorial/code/solutions/Ex10b.fst +++ b/doc/tutorial/code/solutions/Ex10b.fst @@ -13,11 +13,11 @@ val new_point: x:int -> y:int -> ST point (requires (fun h -> True)) (ensures (fun h0 p h1 -> modifies TSet.empty h0 h1 - /\ Heap.fresh (Point.x p ^+^ Point.y p) h0 h1 - /\ Heap.sel h1 (Point.x p) = x - /\ Heap.sel h1 (Point.y p) = y - /\ Heap.contains h1 (Point.x p) //these two lines should be captures by fresh - /\ Heap.contains h1 (Point.y p))) + /\ Heap.fresh (Point?.x p ^+^ Point?.y p) h0 h1 + /\ Heap.sel h1 (Point?.x p) = x + /\ Heap.sel h1 (Point?.y p) = y + /\ Heap.contains h1 (Point?.x p) //these two lines should be captures by fresh + /\ Heap.contains h1 (Point?.y p))) // END: NewPointType // BEGIN: NewPoint let new_point x y = @@ -29,26 +29,26 @@ let new_point x y = // BEGIN: ShiftXType val shift_x: p:point -> ST unit (requires (fun h -> True)) - (ensures (fun h0 x h1 -> modifies (only (Point.x p)) h0 h1)) + (ensures (fun h0 x h1 -> modifies (only (Point?.x p)) h0 h1)) // END: ShiftXType let shift_x p = - Point.x p := !(Point.x p) + 1 + Point?.x p := !(Point?.x p) + 1 val shift_x_p1: p1:point - -> p2:point{ Point.x p2 <> Point.x p1 - /\ Point.y p2 <> Point.x p1 - /\ Point.x p2 <> Point.y p1 - /\ Point.y p2 <> Point.y p1 } + -> p2:point{ Point?.x p2 <> Point?.x p1 + /\ Point?.y p2 <> Point?.x p1 + /\ Point?.x p2 <> Point?.y p1 + /\ Point?.y p2 <> Point?.y p1 } -> ST unit - (requires (fun h -> Heap.contains h (Point.x p2) - /\ Heap.contains h (Point.y p2))) - (ensures (fun h0 _ h1 -> modifies (only (Point.x p1)) h0 h1)) + (requires (fun h -> Heap.contains h (Point?.x p2) + /\ Heap.contains h (Point?.y p2))) + (ensures (fun h0 _ h1 -> modifies (only (Point?.x p1)) h0 h1)) // BEGIN: ShiftXP1 let shift_x_p1 p1 p2 = - let p2_0 = !(Point.x p2), !(Point.y p2) in //p2 is initially p2_0 + let p2_0 = !(Point?.x p2), !(Point?.y p2) in //p2 is initially p2_0 shift_x p1; - let p2_1 = !(Point.x p2), !(Point.y p2) in + let p2_1 = !(Point?.x p2), !(Point?.y p2) in assert (p2_0 = p2_1) //p2 is unchanged // END: ShiftXP1 @@ -76,31 +76,31 @@ val test2: unit -> St unit let test2 () = let p = new_point 0 0 in let z = ST.alloc 0 in - assert (Point.x p <> z) + assert (Point?.x p <> z) // END: Test2 // BEGIN: ShiftP1Solution let shift p = - Point.x p := !(Point.x p) + 1; - Point.y p := !(Point.y p) + 1 + Point?.x p := !(Point?.x p) + 1; + Point?.y p := !(Point?.y p) + 1 val shift_p1: p1:point - -> p2:point{ Point.x p2 <> Point.x p1 - /\ Point.y p2 <> Point.x p1 - /\ Point.x p2 <> Point.y p1 - /\ Point.y p2 <> Point.y p1 } + -> p2:point{ Point?.x p2 <> Point?.x p1 + /\ Point?.y p2 <> Point?.x p1 + /\ Point?.x p2 <> Point?.y p1 + /\ Point?.y p2 <> Point?.y p1 } -> ST unit - (requires (fun h -> Heap.contains h (Point.x p2) - /\ Heap.contains h (Point.y p2))) - (ensures (fun h0 _ h1 -> modifies (Point.x p1 ^+^ Point.y p1) h0 h1)) + (requires (fun h -> Heap.contains h (Point?.x p2) + /\ Heap.contains h (Point?.y p2))) + (ensures (fun h0 _ h1 -> modifies (Point?.x p1 ^+^ Point?.y p1) h0 h1)) let shift_p1 p1 p2 = - let p2_0 = !(Point.x p2), !(Point.y p2) in //p2 is initially p2_0 + let p2_0 = !(Point?.x p2), !(Point?.y p2) in //p2 is initially p2_0 shift p1; - let p2_1 = !(Point.x p2), !(Point.y p2) in + let p2_1 = !(Point?.x p2), !(Point?.y p2) in assert (p2_0 = p2_1) //p2 is unchanged // END: ShiftP1Solution diff --git a/doc/tutorial/code/solutions/Ex11a.fst b/doc/tutorial/code/solutions/Ex11a.fst index 352f71f654a..f080378bf47 100644 --- a/doc/tutorial/code/solutions/Ex11a.fst +++ b/doc/tutorial/code/solutions/Ex11a.fst @@ -34,28 +34,28 @@ type arm = type bot = | Bot : #r:rid - -> pos :point{includes r (Point.r pos)} - -> left :arm {includes r (Arm.r left)} - -> right:arm {includes r (Arm.r right) - /\ disjoint (Point.r pos) (Arm.r left) - /\ disjoint (Point.r pos) (Arm.r right) - /\ disjoint (Arm.r left) (Arm.r right)} + -> pos :point{includes r (Point?.r pos)} + -> left :arm {includes r (Arm?.r left)} + -> right:arm {includes r (Arm?.r right) + /\ disjoint (Point?.r pos) (Arm?.r left) + /\ disjoint (Point?.r pos) (Arm?.r right) + /\ disjoint (Arm?.r left) (Arm?.r right)} -> bot // END: Types // BEGIN: Invariant let flying (b:bot) (h:HyperHeap.t) = - sel h (Point.z (Bot.pos b)) > 0 + sel h (Point?.z (Bot?.pos b)) > 0 let arms_up (b:bot) (h:HyperHeap.t) = - sel h (Arm.polar (Bot.right b)) = 0 - /\ sel h (Arm.polar (Bot.left b)) = 0 + sel h (Arm?.polar (Bot?.right b)) = 0 + /\ sel h (Arm?.polar (Bot?.left b)) = 0 type robot_inv (b:bot) (h:HyperHeap.t) = - Map.contains h (Bot.r b) - /\ Map.contains h (Point.r (Bot.pos b)) - /\ Map.contains h (Arm.r (Bot.left b)) - /\ Map.contains h (Arm.r (Bot.right b)) + Map.contains h (Bot?.r b) + /\ Map.contains h (Point?.r (Bot?.pos b)) + /\ Map.contains h (Arm?.r (Bot?.left b)) + /\ Map.contains h (Arm?.r (Bot?.right b)) /\ (flying b h ==> arms_up b h) // END: Invariant @@ -64,11 +64,11 @@ val new_point: r0:rid -> x:int -> y:int -> z:int -> ST point (requires (fun h0 -> True)) (ensures (fun h0 p h1 -> modifies empty h0 h1 - /\ extends (Point.r p) r0 - /\ fresh_region (Point.r p) h0 h1 - /\ sel h1 (Point.x p) = x - /\ sel h1 (Point.y p) = y - /\ sel h1 (Point.z p) = z)) + /\ extends (Point?.r p) r0 + /\ fresh_region (Point?.r p) h0 h1 + /\ sel h1 (Point?.x p) = x + /\ sel h1 (Point?.y p) = y + /\ sel h1 (Point?.z p) = z)) let new_point r0 x y z = let r = new_region r0 in let x = ralloc r x in @@ -80,8 +80,8 @@ val new_arm: r0:rid -> ST arm (requires (fun h0 -> True)) (ensures (fun h0 x h1 -> modifies empty h0 h1 - /\ extends (Arm.r x) r0 - /\ fresh_region (Arm.r x) h0 h1)) + /\ extends (Arm?.r x) r0 + /\ fresh_region (Arm?.r x) h0 h1)) let new_arm r0 = let r = new_region r0 in let p = ralloc r 0 in @@ -92,8 +92,8 @@ val new_robot: r0:rid -> ST bot (requires (fun h0 -> True)) (ensures (fun h0 x h1 -> modifies empty h0 h1 - /\ extends (Bot.r x) r0 - /\ fresh_region (Bot.r x) h0 h1 + /\ extends (Bot?.r x) r0 + /\ fresh_region (Bot?.r x) h0 h1 /\ robot_inv x h1)) let new_robot r0 = let r = new_region r0 in @@ -106,35 +106,35 @@ let new_robot r0 = val walk_robot_to: x:int -> y:int -> b:bot -> ST unit (requires (robot_inv b)) (ensures (fun h0 u h1 -> - modifies (only (Point.r (Bot.pos b))) h0 h1 + modifies (only (Point?.r (Bot?.pos b))) h0 h1 /\ robot_inv b h1 - /\ sel h1 (Point.z (Bot.pos b)) = sel h1 (Point.z (Bot.pos b)) - /\ sel h1 (Point.x (Bot.pos b)) = x - /\ sel h1 (Point.y (Bot.pos b)) = y)) + /\ sel h1 (Point?.z (Bot?.pos b)) = sel h1 (Point?.z (Bot?.pos b)) + /\ sel h1 (Point?.x (Bot?.pos b)) = x + /\ sel h1 (Point?.y (Bot?.pos b)) = y)) let walk_robot_to x y b = - Point.x (Bot.pos b) := x; - Point.y (Bot.pos b) := y + Point?.x (Bot?.pos b) := x; + Point?.y (Bot?.pos b) := y // BEGIN: Fly val fly: b:bot -> ST unit (requires (fun h -> robot_inv b h)) (ensures (fun h0 _u h1 -> - modifies (only (Bot.r b)) h0 h1 + modifies (only (Bot?.r b)) h0 h1 /\ robot_inv b h1 /\ flying b h1)) let fly b = - Arm.azim (Bot.right b) := 17; - Arm.polar (Bot.left b) := 0; - Arm.polar (Bot.right b) := 0; - Point.z (Bot.pos b) := 100 + Arm?.azim (Bot?.right b) := 17; + Arm?.polar (Bot?.left b) := 0; + Arm?.polar (Bot?.right b) := 0; + Point?.z (Bot?.pos b) := 100 // END: Fly // BEGIN: FlyBoth -val fly_both: b0:bot -> b1:bot{disjoint (Bot.r b0) (Bot.r b1)} +val fly_both: b0:bot -> b1:bot{disjoint (Bot?.r b0) (Bot?.r b1)} -> ST unit (requires (fun h -> robot_inv b0 h /\ robot_inv b1 h)) (ensures (fun h0 x h1 -> - modifies (Bot.r b0 ^+^ Bot.r b1) h0 h1 + modifies (Bot?.r b0 ^+^ Bot?.r b1) h0 h1 /\ robot_inv b0 h1 /\ robot_inv b1 h1 /\ flying b0 h1 @@ -144,10 +144,10 @@ let fly_both b0 b1 = fly b1 // END: FlyBoth -val fly_one: b0:bot -> b1:bot{disjoint (Bot.r b0) (Bot.r b1)} -> ST unit +val fly_one: b0:bot -> b1:bot{disjoint (Bot?.r b0) (Bot?.r b1)} -> ST unit (requires (fun h -> robot_inv b0 h /\ robot_inv b1 h /\ ~(flying b1 h))) (ensures (fun h0 x h1 -> - modifies (only (Bot.r b0)) h0 h1 + modifies (only (Bot?.r b0)) h0 h1 /\ robot_inv b0 h1 /\ robot_inv b1 h1 /\ flying b0 h1 @@ -158,9 +158,9 @@ let fly_one b0 b1 = noeq type bots : set rid -> Type = | Nil : bots empty | Cons : #rs:set rid - -> hd:bot{distinct (Bot.r hd) rs} + -> hd:bot{distinct (Bot?.r hd) rs} -> tl:bots rs - -> bots (rs ++^ Bot.r hd) + -> bots (rs ++^ Bot?.r hd) val mem : #rs:set rid -> bot -> bs:bots rs -> Tot bool (decreases bs) let rec mem (#rs:set rid) b = function @@ -169,7 +169,7 @@ let rec mem (#rs:set rid) b = function val lemma_mem_rid: #rs:set rid -> bs:bots rs -> b:bot -> Lemma (requires (mem #rs b bs)) - (ensures (Set.mem (Bot.r b) rs)) + (ensures (Set.mem (Bot?.r b) rs)) (decreases bs) [SMTPat (mem #rs b bs)] let rec lemma_mem_rid #rs bs b = @@ -177,10 +177,10 @@ let rec lemma_mem_rid #rs bs b = | Nil -> () | Cons hd tl -> if b <> hd then lemma_mem_rid tl b -val lemma_bots_tl_disjoint: #rs:set rid -> bs:bots rs{is_Cons bs} +val lemma_bots_tl_disjoint: #rs:set rid -> bs:bots rs{Cons? bs} -> Lemma (requires True) (ensures (forall b. let Cons hd tl = bs in - mem b tl ==> disjoint (Bot.r b) (Bot.r hd))) + mem b tl ==> disjoint (Bot?.r b) (Bot?.r hd))) let lemma_bots_tl_disjoint #rs bs = () #reset-options "--z3rlimit 10" @@ -193,7 +193,7 @@ let rec fly_robot_army #rs bs = match bs with | Nil -> () | Cons #rs' b bs' -> - //cut (rs == (rs' ++^ Bot.r b)); //not necesary, doesn't improve speed + //cut (rs == (rs' ++^ Bot?.r b)); //not necesary, doesn't improve speed //lemma_bots_tl_disjoint bs; //not necessary; doesnt' improve speed fly b; fly_robot_army bs' diff --git a/doc/tutorial/code/solutions/Ex12.MAC.fst b/doc/tutorial/code/solutions/Ex12.MAC.fst index 7a5bcf5b782..954cc50aa38 100644 --- a/doc/tutorial/code/solutions/Ex12.MAC.fst +++ b/doc/tutorial/code/solutions/Ex12.MAC.fst @@ -57,7 +57,7 @@ let verify k text tag = let m= hmac_sha1 k text in let verified = (Platform.Bytes.equalBytes m tag) in let found = - is_Some + Some? (List.Tot.find (fun (Entry k' text' tag') -> Platform.Bytes.equalBytes k k' && Platform.Bytes.equalBytes text text') !log) in diff --git a/doc/tutorial/code/solutions/Ex12g.TMAC2.fst b/doc/tutorial/code/solutions/Ex12g.TMAC2.fst index 6051bc14f30..b7c5340174e 100644 --- a/doc/tutorial/code/solutions/Ex12g.TMAC2.fst +++ b/doc/tutorial/code/solutions/Ex12g.TMAC2.fst @@ -23,8 +23,8 @@ assume type key_prop : key -> text2 -> Type type pkey (p:(text2 -> Type)) = k:key{ key_prop k == p - /\ BMAC.key_prop (Keys.k0 k) == bspec0 p - /\ BMAC.key_prop (Keys.k1 k) == bspec1 p } + /\ BMAC.key_prop (Keys?.k0 k) == bspec0 p + /\ BMAC.key_prop (Keys?.k1 k) == bspec1 p } val keygen: p:(text2 -> Type) -> pkey p val mac: p:(text2 -> Type) -> k:pkey p -> t:text2{p t} -> tag diff --git a/examples/algorithms/BinarySearch.fst b/examples/algorithms/BinarySearch.fst index bfde83ba3f9..81beb3569d5 100644 --- a/examples/algorithms/BinarySearch.fst +++ b/examples/algorithms/BinarySearch.fst @@ -64,10 +64,10 @@ val bsearch_rec_correct : t:(seq int) -> a:int -> i:nat{i <= length t} -> j:int{-1 <= j /\ j < length t} -> Lemma (requires True) - (ensures (is_Some (bsearch_rec t a i j) ==> - (Some.v (bsearch_rec t a i j) >= i) /\ - (Some.v (bsearch_rec t a i j) <= j) /\ - (index t (Some.v (bsearch_rec t a i j)) = a))) + (ensures (Some? (bsearch_rec t a i j) ==> + (Some?.v (bsearch_rec t a i j) >= i) /\ + (Some?.v (bsearch_rec t a i j) <= j) /\ + (index t (Some?.v (bsearch_rec t a i j)) = a))) (decreases %[(j+1)-i]) let rec bsearch_rec_correct t a i j = if i > j then @@ -86,10 +86,10 @@ let rec bsearch_rec_correct t a i j = val bsearch_correct : t:(seq int) -> a:int -> Lemma (requires True) - (ensures (is_Some (bsearch t a) ==> - (Some.v (bsearch t a) >= 0) /\ - (Some.v (bsearch t a) < (length t)) /\ - (index t (Some.v (bsearch t a)) = a))) + (ensures (Some? (bsearch t a) ==> + (Some?.v (bsearch t a) >= 0) /\ + (Some?.v (bsearch t a) < (length t)) /\ + (index t (Some?.v (bsearch t a)) = a))) let bsearch_correct t a = bsearch_rec_correct t a 0 ((length t)-1) @@ -136,7 +136,7 @@ val bsearch_rec_complete : t:(seq int) (requires (forall i1 i2. (0 <= i1) ==> (i1 <= i2) ==> (i2 < length t) ==> (index t i1 <= index t i2)) /\ (forall p. 0 <= p ==> p < length t ==> index t p = a ==> p < i ==> False) /\ (forall p. 0 <= p ==> p < length t ==> index t p = a ==> j < p ==> False)) - (ensures ((is_None (bsearch_rec t a i j)) ==> + (ensures ((None? (bsearch_rec t a i j)) ==> (forall p. i <= p ==> p <= j ==> index t p = a ==> False))) (decreases %[(j+1)-i]) let rec bsearch_rec_complete t a i j = @@ -159,7 +159,7 @@ val bsearch_complete : t:(seq int) -> a:int -> Lemma (requires (forall i1 i2. (0 <= i1) ==> (i1 <= i2) ==> (i2 < length t) ==> (index t i1 <= index t i2))) - (ensures ((is_None (bsearch t a)) ==> + (ensures ((None? (bsearch t a)) ==> (forall p. 0 <= p ==> p < length t ==> index t p <> a))) let bsearch_complete t a = bsearch_rec_complete t a 0 ((length t)-1) diff --git a/examples/algorithms/Huffman.fst b/examples/algorithms/Huffman.fst index 579b5832cc1..d73de380296 100644 --- a/examples/algorithms/Huffman.fst +++ b/examples/algorithms/Huffman.fst @@ -61,30 +61,30 @@ let rec insertion_sort (ts : list trie) : Pure (list trie) let rec huffman_trie (ts:list trie) : Pure trie (requires (sorted ts /\ List.Tot.length ts > 0)) (ensures (fun t -> - ((List.Tot.length ts > 1 \/ existsb is_Node ts) ==> is_Node t))) + ((List.Tot.length ts > 1 \/ existsb Node? ts) ==> Node? t))) (decreases (List.Tot.length ts)) = match ts with | t1::t2::ts' -> - assert(List.Tot.length ts > 1); (* so it needs to prove is_Node t *) + assert(List.Tot.length ts > 1); (* so it needs to prove Node? t *) let w = weight t1 + weight t2 in let t = huffman_trie ((Node w t1 t2) `insert_in_sorted` ts') in (* by the recursive call we know: (List.Tot.length (Node w t1 t2 `insert_in_sorted` ts') > 1 - \/ existsb is_Node (Node w t1 t2 `insert_in_sorted` ts') ==> is_Node t) *) + \/ existsb Node? (Node w t1 t2 `insert_in_sorted` ts') ==> Node? t) *) (* Since ts' could be empty, I thought that the only way we can - use this is by proving: existsb is_Node (Node w t1 t2 + use this is by proving: existsb Node? (Node w t1 t2 `insert_in_sorted` ts'), which requires induction. But F* was smarter! *) - if is_Nil ts' then - assert(existsb is_Node (Node w t1 t2 `insert_in_sorted` ts')) + if Nil? ts' then + assert(existsb Node? (Node w t1 t2 `insert_in_sorted` ts')) else assert(length (Node w t1 t2 `insert_in_sorted` ts') > 1); - assert(is_Node t); + assert(Node? t); t - | [t1] -> t1 (* this uses `existsb is_Node [t] ==> is_Node t` fact *) + | [t1] -> t1 (* this uses `existsb Node? [t] ==> Node? t` fact *) let huffman (sws:list (symbol*pos)) : Pure trie (requires (b2t (List.Tot.length sws > 0))) - (ensures (fun t -> List.Tot.length sws > 1 ==> is_Node t)) = + (ensures (fun t -> List.Tot.length sws > 1 ==> Node? t)) = huffman_trie (insertion_sort (List.Tot.map (fun (s,w) -> Leaf w s) sws)) let rec encode_one (t:trie) (s:symbol) : Tot (option (list bool)) = @@ -100,8 +100,8 @@ let rec encode_one (t:trie) (s:symbol) : Tot (option (list bool)) = // Modulo the option this is flatten (map (encode_one t) ss) let rec encode (t:trie) (ss:list symbol) : Pure (option (list bool)) (requires (True)) - (ensures (fun bs -> is_Node t /\ is_Cons ss /\ is_Some bs - ==> is_Cons (Some.v bs))) = + (ensures (fun bs -> Node? t /\ Cons? ss /\ Some? bs + ==> Cons? (Some?.v bs))) = match ss with | [] -> None (* can't encode the empty string *) | [s] -> encode_one t s @@ -113,9 +113,9 @@ let rec encode (t:trie) (ss:list symbol) : Pure (option (list bool)) let rec decode_one (t:trie) (bs:list bool) : Pure (option (symbol * list bool)) (requires (True)) - (ensures (fun r -> is_Some r ==> - (List.Tot.length (snd (Some.v r)) <= List.Tot.length bs /\ - (is_Node t ==> List.Tot.length (snd (Some.v r)) < List.Tot.length bs)))) = + (ensures (fun r -> Some? r ==> + (List.Tot.length (snd (Some?.v r)) <= List.Tot.length bs /\ + (Node? t ==> List.Tot.length (snd (Some?.v r)) < List.Tot.length bs)))) = match t, bs with | Node _ t1 t2, b::bs' -> decode_one (if b then t2 else t1) bs' | Leaf _ s, _ -> Some (s, bs) @@ -136,11 +136,11 @@ let rec decode' (t:trie) (bs:list bool) : Tot (option (list symbol)) // Simplified decode using idea from Bird and Wadler's book // (it has more complex termination condition though) -let rec decode_aux (t':trie{is_Node t'}) (t:trie) (bs:list bool) : +let rec decode_aux (t':trie{Node? t'}) (t:trie) (bs:list bool) : Pure (option (list symbol)) (requires (True)) - (ensures (fun ss -> is_Some ss ==> List.Tot.length (Some.v ss) > 0)) - (decreases (%[bs; if is_Leaf t && is_Cons bs then 1 else 0])) + (ensures (fun ss -> Some? ss ==> List.Tot.length (Some?.v ss) > 0)) + (decreases (%[bs; if Leaf? t && Cons? bs then 1 else 0])) = match t, bs with | Leaf _ s, [] -> Some [s] @@ -151,12 +151,12 @@ let rec decode_aux (t':trie{is_Node t'}) (t:trie) (bs:list bool) : | Node _ _ _, [] -> None let decode (t:trie) (bs:list bool) : Pure (option (list symbol)) - (requires (b2t (is_Node t))) (ensures (fun _ -> True)) = + (requires (b2t (Node? t))) (ensures (fun _ -> True)) = decode_aux t t bs let rec cancelation_one (t':trie) (t:trie) (s:symbol) : Lemma - (requires (b2t (is_Node t'))) - (ensures (is_Node t' ==> + (requires (b2t (Node? t'))) + (ensures (Node? t' ==> (match encode_one t s with | Some e -> (match decode_aux t' t e with | Some d -> d = [s] @@ -169,29 +169,29 @@ let rec cancelation_one (t':trie) (t:trie) (s:symbol) : Lemma | Some e -> cancelation_one t' t1 s | None -> cancelation_one t' t2 s) -let rec decode_prefix_aux (t':trie{is_Node t'}) (t:trie) +let rec decode_prefix_aux (t':trie{Node? t'}) (t:trie) (bs:list bool) (bs':list bool) (s:symbol) : Lemma (requires (decode_aux t' t bs = Some [s])) - (ensures (is_Cons bs' ==> decode_aux t' t (bs @ bs') = + (ensures (Cons? bs' ==> decode_aux t' t (bs @ bs') = (match decode_aux t' t' bs' with | Some ss -> Some (s :: ss) | None -> None))) - (decreases (%[bs; if is_Leaf t && is_Cons bs then 1 else 0])) = + (decreases (%[bs; if Leaf? t && Cons? bs then 1 else 0])) = match t, bs with | Leaf _ _, [] -> () | Leaf _ _, _::_ -> decode_prefix_aux t' t' bs bs' s | Node _ t1 t2, b::bs'' -> decode_prefix_aux t' (if b then t2 else t1) bs'' bs' s -let rec decode_prefix (t:trie{is_Node t}) - (bs:list bool) (bs':list bool{is_Cons bs'}) (s:symbol) : Lemma +let rec decode_prefix (t:trie{Node? t}) + (bs:list bool) (bs':list bool{Cons? bs'}) (s:symbol) : Lemma (requires (decode t bs = Some [s])) (ensures (decode t (bs @ bs') = (match decode t bs' with | Some ss -> Some (s :: ss) | None -> None))) = decode_prefix_aux t t bs bs' s -let rec cancelation_aux (t:trie{is_Node t}) (ss:list symbol) : Lemma +let rec cancelation_aux (t:trie{Node? t}) (ss:list symbol) : Lemma (requires (True)) (ensures (match encode t ss with | Some e -> (match decode t e with diff --git a/examples/algorithms/IntSort.fst b/examples/algorithms/IntSort.fst index 18e6bbb79c7..9192d5804a5 100644 --- a/examples/algorithms/IntSort.fst +++ b/examples/algorithms/IntSort.fst @@ -8,7 +8,7 @@ let rec sorted l = match l with | x::y::xs -> (x <= y) && (sorted (y::xs)) val test_sorted: x:int -> l:list int -> - Lemma ((sorted (x::l) /\ is_Cons l) ==> x <= Cons.hd l) + Lemma ((sorted (x::l) /\ Cons? l) ==> x <= Cons?.hd l) let test_sorted x l = () val test_sorted2: unit -> Tot (m:list int{sorted m}) diff --git a/examples/algorithms/MergeSort.fst b/examples/algorithms/MergeSort.fst index 2e7fd19e47d..f4e251c5fd1 100644 --- a/examples/algorithms/MergeSort.fst +++ b/examples/algorithms/MergeSort.fst @@ -8,7 +8,7 @@ type split_inv (l:list int) (l1:list int) (l2:list int) = length l > length l1 /\ length l > length l2 val split: l:list int -> Pure (list int * list int) - (requires (is_Cons l /\ is_Cons (Cons.tl l))) + (requires (Cons? l /\ Cons? (Cons?.tl l))) (ensures (fun r -> split_inv l (fst r) (snd r))) let rec split (x::y::l) = match l with @@ -20,9 +20,9 @@ let rec split (x::y::l) = (* Verification succeeds even without this invariant; it just takes a lot longer (22s vs 7s) *) type merge_inv (l1:list int) (l2:list int) (l:list int) = - (is_Cons l1 /\ is_Cons l /\ Cons.hd l1 = Cons.hd l) \/ - (is_Cons l2 /\ is_Cons l /\ Cons.hd l2 = Cons.hd l) \/ - (is_Nil l1 /\ is_Nil l2 /\ is_Nil l) + (Cons? l1 /\ Cons? l /\ Cons?.hd l1 = Cons?.hd l) \/ + (Cons? l2 /\ Cons? l /\ Cons?.hd l2 = Cons?.hd l) \/ + (Nil? l1 /\ Nil? l2 /\ Nil? l) val merge: l1:list int -> l2:list int -> Pure (list int) (requires (sorted l1 /\ sorted l2)) diff --git a/examples/algorithms/QuickSort.Array.fst b/examples/algorithms/QuickSort.Array.fst index f0f487ad8b9..34e4d7bbbda 100644 --- a/examples/algorithms/QuickSort.Array.fst +++ b/examples/algorithms/QuickSort.Array.fst @@ -22,6 +22,11 @@ open FStar.Heap open FStar.ST #set-options "--initial_fuel 1 --initial_ifuel 0 --max_fuel 1 --max_ifuel 0" +(* 2016-11-22: Due to the QuickSort namespace being opened *after* the +FStar namespace,Array resolves to QuickSort.Array instead of +FStar.Array, so we have to fix this explicitly as a module abbrev. *) +module Array = FStar.Array + type partition_inv (a:eqtype) (f:tot_ord a) (lo:seq a) (pv:a) (hi:seq a) = ((length hi) >= 0) /\ (forall y. (mem y hi ==> f pv y) /\ (mem y lo ==> f y pv)) diff --git a/examples/algorithms/QuickSort.Seq.fst b/examples/algorithms/QuickSort.Seq.fst index 62bef0ba17a..fe51ba91b2a 100644 --- a/examples/algorithms/QuickSort.Seq.fst +++ b/examples/algorithms/QuickSort.Seq.fst @@ -2,6 +2,11 @@ module QuickSort.Seq open FStar.Seq open FStar.SeqProperties +(* 2016-11-22: Due to the QuickSort namespace being opened *after* the +FStar namespace, Seq resolves to QuickSort.Seq instead of FStar.Seq, +so we have to fix this explicitly as a module abbrev. *) +module Seq = FStar.Seq + #set-options "--max_fuel 0 --initial_fuel 0 --initial_ifuel 0 --max_ifuel 0" #reset-options "--z3rlimit 40" diff --git a/examples/algorithms/Uf.fst b/examples/algorithms/Uf.fst index 8e98c1fdcad..8aa9bb2d4ce 100644 --- a/examples/algorithms/Uf.fst +++ b/examples/algorithms/Uf.fst @@ -67,7 +67,7 @@ assume val recall_reachable : #a:Type -> #a2:Type -> #b:Type -> h:heap -> r:ref let recall_step (#a:eqtype) (h:heap) (z:uf a) (y:uf a) : Lemma (requires (reach a h z = Some y)) (ensures (Heap.contains h y.parent)) = - recall_reachable h z.parent (fun (r : (option (uf a)){is_Some r}) -> match r with | Some y -> y.parent) + recall_reachable h z.parent (fun (r : (option (uf a)){Some? r}) -> match r with | Some y -> y.parent) //assume val recall_step : #a:eqtype -> h:heap -> z:uf a -> y:uf a -> Lemma (requires (reach a h z = Some y)) (ensures (Heap.contains h y.parent)) diff --git a/examples/algorithms/Unification.fst b/examples/algorithms/Unification.fst index f6f1e561313..0e289740a7a 100644 --- a/examples/algorithms/Unification.fst +++ b/examples/algorithms/Unification.fst @@ -159,7 +159,7 @@ let rec unify e s = match e with | [] -> Some s | (V x, t)::tl -> - if is_V t && V.i t = x + if V? t && V?.i t = x then unify tl s //t is a flex-rhs else if occurs x t then None @@ -284,7 +284,7 @@ let rec lsubst_funs_monotone l t = match l with | hd::tl -> lsubst_funs_monotone tl t; subst_funs_monotone hd (lsubst_term tl t) -val lemma_occurs_not_solveable_aux: x:nat -> t:term{occurs x t /\ not (is_V t)} -> s:list subst -> Lemma +val lemma_occurs_not_solveable_aux: x:nat -> t:term{occurs x t /\ not (V? t)} -> s:list subst -> Lemma (funs (lsubst_term s t) >= (funs t + funs (lsubst_term s (V x)))) let rec lemma_occurs_not_solveable_aux x t s = match t with | F t1 t2 -> @@ -304,7 +304,7 @@ type not_solveable s = forall l. lsubst_term l (fst s) <> lsubst_term l (snd s) val lemma_occurs_not_solveable: x:nat -> t:term -> Lemma - (requires (occurs x t /\ not (is_V t))) + (requires (occurs x t /\ not (V? t))) (ensures (not_solveable (V x, t))) let lemma_occurs_not_solveable x t = FStar.Classical.forall_intro (lemma_occurs_not_solveable_aux x t) @@ -355,7 +355,7 @@ let rec unify_correct_aux l = function | hd::tl -> begin match hd with | (V x, y) -> - if is_V y && V.i y=x + if V? y && V?.i y=x then unify_correct_aux l tl else if occurs x y then (lemma_occurs_not_solveable x y; []) @@ -392,9 +392,9 @@ let unify_eqns e = unify e [] val unify_eqns_correct: e:eqns -> Lemma (requires True) - (ensures (if is_None (unify_eqns e) + (ensures (if None? (unify_eqns e) then not_solveable_eqns e - else solved (lsubst_eqns (Some.v (unify_eqns e)) e))) + else solved (lsubst_eqns (Some?.v (unify_eqns e)) e))) let unify_eqns_correct e = let _ = unify_correct_aux [] e in () diff --git a/examples/crypto/Bloom.Format.fst b/examples/crypto/Bloom.Format.fst index 9b8a6f54cb6..726e0f328a1 100644 --- a/examples/crypto/Bloom.Format.fst +++ b/examples/crypto/Bloom.Format.fst @@ -44,7 +44,7 @@ let signal s c = append tag0 (append s_b c_b) val signal_split : m:msg signal_size -> Tot (x:option (uint32 * uint16) - { is_Some x ==> m = signal (fst (Some.v x)) (snd (Some.v x))}) + { Some? x ==> m = signal (fst (Some.v x)) (snd (Some.v x))}) let signal_split m = let (t, sc) = split_eq m 1 in if t = tag0 then diff --git a/examples/crypto/Cert.Sig.fst b/examples/crypto/Cert.Sig.fst index 48f1f528e60..4bfd5d337c6 100644 --- a/examples/crypto/Cert.Sig.fst +++ b/examples/crypto/Cert.Sig.fst @@ -53,7 +53,7 @@ let sign (SK sk) text = let verify vk text tag = let verified = DSA.verify vk text tag in let found = - is_Some + Some? (List.find (fun (Entry k text') -> k=vk && text=text') !log) in diff --git a/examples/crypto/EtM.AE.fst b/examples/crypto/EtM.AE.fst index e8f9f1e82b3..85487bbc2fe 100644 --- a/examples/crypto/EtM.AE.fst +++ b/examples/crypto/EtM.AE.fst @@ -20,27 +20,27 @@ type log_t (r:rid) = m_rref r (seq (CPA.msg * cipher)) grows noeq type key = | Key: #region:rid -> - ke:CPA.key { extends (CPA.Key.region ke) region } -> - km:MAC.key { extends (MAC.Key.region km) region /\ - (disjoint( CPA.Key.region ke) (MAC.Key.region km)) } -> + ke:CPA.key { extends (CPA.Key?.region ke) region } -> + km:MAC.key { extends (MAC.Key?.region km) region /\ + (disjoint( CPA.Key?.region ke) (MAC.Key?.region km)) } -> log:log_t region -> key let get_log (h:mem) (k:key) = m_sel h k.log let get_mac_log (h:mem) (k:key) = - m_sel h (MAC.Key.log k.km) + m_sel h (MAC.Key?.log k.km) let get_cpa_log (h:mem) (k:key) = - m_sel h (CPA.Key.log k.ke) + m_sel h (CPA.Key?.log k.ke) let invariant (h:mem) (k:key) = let log = get_log h k in let mac_log = get_mac_log h k in let cpa_log = get_cpa_log h k in Map.contains h.h k.region /\ - Map.contains h.h (MAC.Key.region k.km) /\ - Map.contains h.h (CPA.Key.region k.ke) /\ + Map.contains h.h (MAC.Key?.region k.km) /\ + Map.contains h.h (CPA.Key?.region k.ke) /\ Seq.length log = Seq.length mac_log /\ Seq.length mac_log = Seq.length cpa_log /\ (forall (i:int). indexable log i ==> @@ -93,8 +93,8 @@ val decrypt: k:key -> c:cipher -> ST (option Plain.plain) (ensures (fun h0 res h1 -> modifies_none h0 h1 /\ invariant h1 k /\ - ( (b2t Ideal.uf_cma /\ is_Some res) ==> - (is_Some (seq_find (fun (_,c') -> c = c') (get_log h0 k))) + ( (b2t Ideal.uf_cma /\ Some? res) ==> + (Some? (seq_find (fun (_,c') -> c = c') (get_log h0 k))) (* CH*MK: If we wanted to also prove correctness of the EtM.AE we would use this stronger post-condition: diff --git a/examples/crypto/EtM.CPA.fst b/examples/crypto/EtM.CPA.fst index e69c1b4361d..b1ae1300691 100644 --- a/examples/crypto/EtM.CPA.fst +++ b/examples/crypto/EtM.CPA.fst @@ -87,19 +87,19 @@ let encryption_injective k iv t1 t2 = correctness k iv t1; correctness k iv t2 (* this doesn't really belong here *) val mem : #a:eqtype -> x:a -> xs:Seq.seq a -> Tot bool -let mem (#a:eqtype) x xs = is_Some (SeqProperties.seq_find (fun y -> y = x) xs) +let mem (#a:eqtype) x xs = Some? (SeqProperties.seq_find (fun y -> y = x) xs) val decrypt: k:key -> c:cipher -> ST msg (requires (fun h0 -> Map.contains h0.h k.region /\ (let log0 = m_sel h0 k.log in - (b2t ind_cpa_rest_adv) ==> is_Some (seq_find (fun mc -> snd mc = c) log0)))) + (b2t ind_cpa_rest_adv) ==> Some? (seq_find (fun mc -> snd mc = c) log0)))) (ensures (fun h0 res h1 -> modifies_none h0 h1 /\ ( (b2t ind_cpa_rest_adv) ==> mem (res,c) (m_sel h0 k.log) (* (let log0 = m_sel h0 k.log in *) //specification of correctness (* let found = seq_find (fun mc -> snd mc = c) log0 in *) - (* is_Some found /\ fst (Some.v found) = res) *) + (* Some? found /\ fst (Some.v found) = res) *) ) ) ) diff --git a/examples/crypto/HyE.AE.fst b/examples/crypto/HyE.AE.fst index b4d7d913986..f6ffffa4538 100644 --- a/examples/crypto/HyE.AE.fst +++ b/examples/crypto/HyE.AE.fst @@ -74,14 +74,14 @@ let encrypt k m : cipher = (* this doesn't really belong here *) val mem : #a:eqtype -> x:a -> xs:Seq.seq a -> Tot bool -let mem (#a:eqtype) x xs = is_Some (SeqProperties.seq_find (fun y -> y = x) xs) +let mem (#a:eqtype) x xs = Some? (SeqProperties.seq_find (fun y -> y = x) xs) val decrypt: k:key -> c:cipher -> ST (option msg) (requires (fun h0 -> True (* Could require Map.contains h0 k.region *) )) (ensures (fun h0 res h1 -> modifies_none h0 h1 /\ - ( (b2t int_ctxt /\ is_Some res) ==> mem (Some.v res,c) (m_sel h0 k.log) + ( (b2t int_ctxt /\ Some? res) ==> mem (Some?.v res,c) (m_sel h0 k.log) ) ) ) @@ -97,7 +97,7 @@ let decrypt k c = let iv,c' = split c ivsize in assume( B.length c' >= aeadTagSize AES_128_GCM); let poption = (CoreCrypto.aead_decrypt AES_128_GCM k.raw iv empty_bytes c') in - if is_Some poption then - Some (coerce (Some.v poption)) + if Some? poption then + Some (coerce (Some?.v poption)) else None diff --git a/examples/crypto/HyE.CCA2.fst b/examples/crypto/HyE.CCA2.fst index 72ed8a14909..2737698cdf6 100644 --- a/examples/crypto/HyE.CCA2.fst +++ b/examples/crypto/HyE.CCA2.fst @@ -24,7 +24,7 @@ noeq abstract type pkey = | PKey: #region:rid -> rawpk:RSA.pkey -> log: log_t region -> pkey let access_pk_raw (pk:pkey) = - PKey.rawpk pk + PKey?.rawpk pk noeq abstract type skey = @@ -47,9 +47,9 @@ let encrypt pk (p:PlainPKE.t) : RSA.cipher = let decrypt sk (c:RSA.cipher) : option (PlainPKE.t) = - let log = m_read (PKey.log sk.pk) in + let log = m_read (PKey?.log sk.pk) in match Ideal.ind_cca, seq_find (function Entry c' _ -> c=c') log with - | true, Some t -> Some(Entry.p t) + | true, Some t -> Some(Entry?.p t) | _, _ -> None | false, _ -> (match RSA.dec sk.raw c with diff --git a/examples/crypto/HyE.HCCA2.fst b/examples/crypto/HyE.HCCA2.fst index f37b9fc865d..25068ecf007 100644 --- a/examples/crypto/HyE.HCCA2.fst +++ b/examples/crypto/HyE.HCCA2.fst @@ -20,7 +20,7 @@ noeq abstract type pkey = | PKey: #region:rid -> rawpk:RSA.pkey -> cca_pk:CCA2.pkey -> pkey let access_pkraw (pk:pkey) = - PKey.rawpk pk + PKey?.rawpk pk noeq abstract type skey = | SKey: cca_sk:CCA2.skey -> pk:pkey -> skey type p = P.t diff --git a/examples/crypto/MAC.fst b/examples/crypto/MAC.fst index c75064e8a7f..c39f5f494cb 100644 --- a/examples/crypto/MAC.fst +++ b/examples/crypto/MAC.fst @@ -65,7 +65,7 @@ let verify k text tag = let m= hmac_sha1 k text in let verified = (Platform.Bytes.equalBytes m tag) in let found = - is_Some + Some? (List.Tot.find (fun (Entry k' text' tag') -> Platform.Bytes.equalBytes k k' && Platform.Bytes.equalBytes text text') !log) in diff --git a/examples/crypto/Sig.fst b/examples/crypto/Sig.fst index 425c1787482..e038146c5a8 100644 --- a/examples/crypto/Sig.fst +++ b/examples/crypto/Sig.fst @@ -64,4 +64,4 @@ val verify: p:pk -> b:bool{b ==> key_prop p t} let verify p t m = let found = List.Tot.find (function (Entry p' t' _) -> p=p' && t=t') !log in - is_Some found + Some? found diff --git a/examples/crypto/StatefulEncryption.MultiInstance.Frame.fst b/examples/crypto/StatefulEncryption.MultiInstance.Frame.fst index 4fb4fde7d52..830f54f6734 100644 --- a/examples/crypto/StatefulEncryption.MultiInstance.Frame.fst +++ b/examples/crypto/StatefulEncryption.MultiInstance.Frame.fst @@ -19,13 +19,13 @@ assume Length_emp: forall (a:Type).{:pattern (Seq.length (emp #a))} Seq.length ( // we'll need variants passing i to f, and showing forall j. j < i ==> not f(Seq.index s j) assume val find_seq : #a:Type -> f:(a -> Tot bool) -> s:seq a - -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { is_None o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) + -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { None? o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) (* TODO not quite typing... // i is the next index to try val find_seq' : #a:Type -> f:(a -> Tot bool) -> s:seq a -> i:nat { i <= Seq.length s /\ (forall (j:nat{j - Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)} /\ (forall (j:nat{j (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) + Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)} /\ (forall (j:nat{j (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) let rec find_seq' a f s i = if i = Seq.length s then None else if f (Seq.index s i) then Some i @@ -158,8 +158,8 @@ val dec: d:decryptor -> a:ad -> c:cipher -> ST (option plain) /\ dec_in_basic_fp d h1 /\ (Let (Heap.sel h0 (Dec.log d)) (fun log -> - (is_None o <==> (forall (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ ~(basicMatch a c (Seq.index log i)))) - /\ (is_Some o ==> (exists (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ basicMatch a c (Seq.index log i) /\ Entry.p (Seq.index log i) = Some.v o)))))) + (None? o <==> (forall (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ ~(basicMatch a c (Seq.index log i)))) + /\ (Some? o ==> (exists (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ basicMatch a c (Seq.index log i) /\ Entry.p (Seq.index log i) = Some.v o)))))) let dec d a c = let s = !(Dec.log d) in match find_seq (basicMatch a c) s with @@ -327,10 +327,10 @@ val stateful_dec: d:st_decryptor -> c:cipher -> ST (option plain) /\ modifies !{StDec.ctr d} h0 h1 /\ Let (Heap.sel h0 (StDec.ctr d)) (fun (r:nat{r=Heap.sel h0 (StDec.ctr d)}) -> Let (Heap.sel h0 (StDec.log d)) (fun (log:seq statefulEntry{log=Heap.sel h0 (StDec.log d)}) -> - (is_None p ==> (r = Seq.length log //nothing encrypted yet + (None? p ==> (r = Seq.length log //nothing encrypted yet || StEntry.c (Seq.index log r) <> c //wrong cipher ) /\ Heap.sel h1 (StDec.ctr d) = r) - /\ (is_Some p ==> + /\ (Some? p ==> ((Heap.sel h1 (StDec.ctr d) = r + 1) /\ StEntry.p (Seq.index log r) = Some.v p)))))) #reset-options diff --git a/examples/crypto/StatefulEncryption.MultiInstance.fst b/examples/crypto/StatefulEncryption.MultiInstance.fst index 46f3764928e..f5ad8650407 100644 --- a/examples/crypto/StatefulEncryption.MultiInstance.fst +++ b/examples/crypto/StatefulEncryption.MultiInstance.fst @@ -66,7 +66,7 @@ let enc e p = c assume val find_seq : #a:Type -> f:(a -> Tot bool) -> s:seq a - -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { is_None o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) + -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { None? o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) val dec: d:decryptor -> c:cipher -> ST (option plain) (requires (fun h -> True)) @@ -74,8 +74,8 @@ val dec: d:decryptor -> c:cipher -> ST (option plain) modifies !{} h0 h1 /\ (Let (Heap.sel h0 (Dec.log d)) (fun log -> - (is_None p ==> (forall (i:nat{i < Seq.length log}). Entry.c (Seq.index log i) <> c)) - /\ (is_Some p ==> (exists (i:nat{i < Seq.length log}). Seq.index log i = Entry (Some.v p) c)))))) + (None? p ==> (forall (i:nat{i < Seq.length log}). Entry.c (Seq.index log i) <> c)) + /\ (Some? p ==> (exists (i:nat{i < Seq.length log}). Seq.index log i = Entry (Some.v p) c)))))) let dec d c = let s = !(Dec.log d) in match find_seq (function Entry p c' -> c=c') s with @@ -173,10 +173,10 @@ val stateful_dec: ad:nat -> d:st_decryptor -> c:cipher -> ST (option plain) /\ modifies !{StDec.ctr d} h0 h1 /\ Let (Heap.sel h0 (StDec.ctr d)) (fun (r:nat{r=Heap.sel h0 (StDec.ctr d)}) -> Let (Heap.sel h0 (StDec.log d)) (fun (log:seq statefulEntry{log=Heap.sel h0 (StDec.log d)}) -> - (is_None p ==> (r = Seq.length log //nothing encrypted yet + (None? p ==> (r = Seq.length log //nothing encrypted yet || StEntry.c (Seq.index log r) <> c //bogus cipher || r <> ad)) //reading at the wrong postition - /\ (is_Some p ==> + /\ (Some? p ==> ((Heap.sel h1 (StDec.ctr d) = r + 1) /\ StEntry.p (Seq.index log r) = Some.v p)))))) let stateful_dec ad d c = diff --git a/examples/crypto/StatefulEncryption.SingleInstance.fst b/examples/crypto/StatefulEncryption.SingleInstance.fst index 6aa7b2e3be5..4ee5ec6daf1 100644 --- a/examples/crypto/StatefulEncryption.SingleInstance.fst +++ b/examples/crypto/StatefulEncryption.SingleInstance.fst @@ -35,7 +35,7 @@ let enc k p = type Let (#a:Type) (x:a) (body: a -> Type) = body x assume val find_seq : #a:Type -> f:(a -> Tot bool) -> s:seq a - -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { is_None o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) + -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { None? o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) val dec: key -> c:cipher -> ST (option plain) (requires (fun h -> Heap.contains h basicLog)) @@ -43,8 +43,8 @@ val dec: key -> c:cipher -> ST (option plain) modifies Set.empty h0 h1 /\ (Let (Heap.sel h0 basicLog) (fun log -> - is_None p ==> (forall (i:nat{i < Seq.length log}). Entry.c (Seq.index log i) <> c) - /\ is_Some p ==> (exists (i:nat{i < Seq.length log}). Seq.index log i = Entry (Some.v p) c))))) + None? p ==> (forall (i:nat{i < Seq.length log}). Entry.c (Seq.index log i) <> c) + /\ Some? p ==> (exists (i:nat{i < Seq.length log}). Seq.index log i = Entry (Some.v p) c))))) let dec key c = let s = !basicLog in match find_seq (function Entry p c' -> c=c') s with diff --git a/examples/crypto/StatefulEncryption.TwoLevelHeap.fst b/examples/crypto/StatefulEncryption.TwoLevelHeap.fst index 33175e319b3..8aa9b65709e 100644 --- a/examples/crypto/StatefulEncryption.TwoLevelHeap.fst +++ b/examples/crypto/StatefulEncryption.TwoLevelHeap.fst @@ -48,7 +48,7 @@ let gen () = Both region (Enc log key) (Dec log key) assume val find_seq : #a:Type -> f:(a -> Tot bool) -> s:seq a - -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { is_None o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) + -> Tot (o:option (i:nat{i < Seq.length s /\ f (Seq.index s i)}) { None? o ==> (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i)))}) assume val enc0: s:seq cipher (* ghost *) -> ST cipher (fun h -> True) @@ -74,9 +74,9 @@ val dec: #i:rid -> d:decryptor i -> a:ad -> c:cipher -> ST (option plain) TwoLevelHeap.modifies Set.empty h0 h1 /\ (Let (sel h0 (Dec.log d)) (fun log -> - (is_None o ==> (forall (i:nat{i < Seq.length log}).{:pattern (trigger i)} + (None? o ==> (forall (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ ~(basicMatch a c (Seq.index log i)))) - /\ (is_Some o ==> (exists (i:nat{i < Seq.length log}).{:pattern (trigger i)} + /\ (Some? o ==> (exists (i:nat{i < Seq.length log}).{:pattern (trigger i)} trigger i /\ basicMatch a c (Seq.index log i) /\ Entry.p (Seq.index log i) = Some.v o)))))) @@ -203,10 +203,10 @@ val stateful_dec: #i:rid -> d:st_decryptor i -> c:cipher -> ST (option plain) /\ Heap.modifies !{as_ref (StDec.ctr d)} (Map.sel h0 i) (Map.sel h1 i) /\ Let (sel h0 (StDec.ctr d)) (fun (r:nat{r=sel h0 (StDec.ctr d)}) -> Let (sel h0 (StDec.log d)) (fun (log:seq statefulEntry{log=sel h0 (StDec.log d)}) -> - (is_None p ==> (r = Seq.length log //nothing encrypted yet + (None? p ==> (r = Seq.length log //nothing encrypted yet || StEntry.c (Seq.index log r) <> c //wrong cipher ) /\ sel h1 (StDec.ctr d) = r) - /\ (is_Some p ==> + /\ (Some? p ==> ((sel h1 (StDec.ctr d) = r + 1) /\ StEntry.p (Seq.index log r) = Some.v p)))))) // note that we do not increment the counter in case of decryption failure, diff --git a/examples/crypto/attic/pke.fst b/examples/crypto/attic/pke.fst index c847e0ff57d..13d01c34055 100644 --- a/examples/crypto/attic/pke.fst +++ b/examples/crypto/attic/pke.fst @@ -39,7 +39,7 @@ type r = RSA.plain val repr: t -> Tot r let repr t = t (* a pure function from t to RSA.plain *) -val plain: x:r -> Pure (option t) (requires True) (ensures (fun o -> is_Some o /\ repr (Some.v o) = x)) +val plain: x:r -> Pure (option t) (requires True) (ensures (fun o -> Some? o /\ repr (Some.v o) = x)) let plain t = Some t (* a partial function from RSA.plain to t *) diff --git a/examples/data_structures/ArrayRealized.fst b/examples/data_structures/ArrayRealized.fst index 579f88b59a9..0a8ab90906d 100644 --- a/examples/data_structures/ArrayRealized.fst +++ b/examples/data_structures/ArrayRealized.fst @@ -32,13 +32,13 @@ val create: n:nat -> init:'a -> Tot (seq 'a) let create n init = Seq (Const init) 0 n val length: s:seq 'a -> Tot nat -let length s = Seq.end_i s - Seq.start_i s +let length s = Seq?.end_i s - Seq?.start_i s val __index__: contents 'a -> int -> Tot 'a let rec __index__ c i = match c with | Const v -> v | Upd j v tl -> if i=j then v else __index__ tl i - | Append s1 s2 -> if i < length s1 then __index__ (Seq.c s1) i else __index__ (Seq.c s2) (i - length s1) + | Append s1 s2 -> if i < length s1 then __index__ (Seq?.c s1) i else __index__ (Seq?.c s2) (i - length s1) val index: s:seq 'a -> i:nat{length s > i} -> Tot 'a let index (Seq c j k) i = __index__ c (i + j) @@ -49,8 +49,8 @@ let rec __update__ c i v = match c with | Upd _ _ _ -> Upd i v c | Append s1 s2 -> if i < length s1 - then Append (Seq (__update__ (Seq.c s1) i v) (Seq.start_i s1) (Seq.end_i s1)) s2 - else Append s1 (Seq (__update__ (Seq.c s2) (i - length s1) v) (Seq.start_i s2) (Seq.end_i s2)) + then Append (Seq (__update__ (Seq?.c s1) i v) (Seq?.start_i s1) (Seq?.end_i s1)) s2 + else Append s1 (Seq (__update__ (Seq?.c s2) (i - length s1) v) (Seq?.start_i s2) (Seq?.end_i s2)) val update: s:seq 'a -> i:nat{length s > i} -> v:'a -> Tot (seq 'a) let update (Seq c j k) i v = Seq (__update__ c (i + j) v) j k @@ -68,6 +68,6 @@ type equal (#a:Type) (s1:seq a) (s2:seq a) = (length s1 == length s2 /\ (forall (i:int). (0 <= i /\ i < length s1) - ==> __index__ (Seq.c s1) i == __index__ (Seq.c s2) i)) + ==> __index__ (Seq?.c s1) i == __index__ (Seq?.c s2) i)) assume val eq: #a:Type -> s1:seq a -> s2:seq a -> Tot (b:bool{b ==> equal s1 s2}) diff --git a/examples/data_structures/BinarySearchTreeBasic.fst b/examples/data_structures/BinarySearchTreeBasic.fst index d1dbb37e82d..936ec80c934 100644 --- a/examples/data_structures/BinarySearchTreeBasic.fst +++ b/examples/data_structures/BinarySearchTreeBasic.fst @@ -91,18 +91,18 @@ let rec insert_lemma x t = match t with val ge : int -> int -> Tot bool let ge n1 n2 = n1 >= n2 -val find_max : t:tree{is_bst t /\ is_Node t} -> +val find_max : t:tree{is_bst t /\ Node? t} -> Tot (x:int{b2t (all (ge x) t) /\ in_tree x t}) -let rec find_max (Node n _ t2) = if is_Leaf t2 then n else find_max t2 +let rec find_max (Node n _ t2) = if Leaf? t2 then n else find_max t2 -val find_max' : t:tree{is_Node t}-> Tot int -let rec find_max' (Node n _ t2) = if is_Leaf t2 then n else find_max' t2 +val find_max' : t:tree{Node? t}-> Tot int +let rec find_max' (Node n _ t2) = if Leaf? t2 then n else find_max' t2 -val find_max_lemma : t:tree{is_Node t /\ is_bst t} -> +val find_max_lemma : t:tree{Node? t /\ is_bst t} -> Lemma (in_tree (find_max' t) t /\ b2t (all (ge (find_max' t)) t)) -let rec find_max_lemma (Node _ _ t2) = if is_Node t2 then find_max_lemma t2 +let rec find_max_lemma (Node _ _ t2) = if Node? t2 then find_max_lemma t2 -val find_max_eq : t:tree{is_Node t /\ is_bst t} -> Lemma (find_max t = find_max' t) +val find_max_eq : t:tree{Node? t /\ is_bst t} -> Lemma (find_max t = find_max' t) let find_max_eq t = find_max_lemma t val delete : x:int -> t:tree{is_bst t} -> @@ -141,4 +141,4 @@ let rec delete_lemma x t = match t with | Leaf -> () | Node n t1 t2 -> if x <> n then (delete_lemma x t1; delete_lemma x t2) - else if is_Node t1 then (find_max_lemma t1; delete_lemma (find_max' t1) t1) + else if Node? t1 then (find_max_lemma t1; delete_lemma (find_max' t1) t1) diff --git a/examples/data_structures/BinarySearchTreeFirst.fst b/examples/data_structures/BinarySearchTreeFirst.fst index d59a9770600..dc781910923 100644 --- a/examples/data_structures/BinarySearchTreeFirst.fst +++ b/examples/data_structures/BinarySearchTreeFirst.fst @@ -34,8 +34,8 @@ type tree: int -> Type = -> #r :int -> right:option (tree r){l <= n /\ n <= r - /\ (is_None right <==> n=r) - /\ (is_None left <==> n=l)} + /\ (None? right <==> n=r) + /\ (None? left <==> n=l)} -> tree r (* Need to supply #i for the empty sub-trees, since it can't be inferred by unification *) @@ -65,8 +65,8 @@ let rec contains (#k:int) t key = then false else let Node left i right = t in i=k - || (key < i && is_Some left && contains (Some.v left) key) - || (is_Some right && contains (Some.v right) key) + || (key < i && Some? left && contains (Some?.v left) key) + || (Some? right && contains (Some?.v right) key) val in_order_opt: #k:int -> t:option (tree k) -> Tot (list int) (decreases t) let rec in_order_opt (#k:int) t = match t with diff --git a/examples/data_structures/RBTree.fst b/examples/data_structures/RBTree.fst index 76eaf0d83db..7c16a6a6faf 100644 --- a/examples/data_structures/RBTree.fst +++ b/examples/data_structures/RBTree.fst @@ -50,13 +50,13 @@ let rec black_height t = match t with | _, _ -> None (* returns the minimum element in a T tree (E tree has no element) *) -val min_elt: t:rbtree' -> Pure nat (requires (b2t (is_T t))) (ensures (fun r -> True)) +val min_elt: t:rbtree' -> Pure nat (requires (b2t (T? t))) (ensures (fun r -> True)) let rec min_elt (T _ a x _) = match a with | E -> x | _ -> min_elt a (* returns the maximum element in a T tree *) -val max_elt: t:rbtree' -> Pure nat (requires (b2t (is_T t))) (ensures (fun r -> True)) +val max_elt: t:rbtree' -> Pure nat (requires (b2t (T? t))) (ensures (fun r -> True)) let rec max_elt (T _ _ x b) = match b with | E -> x | _ -> max_elt b @@ -80,7 +80,7 @@ let rec c_inv t = match t with * in a red black tree, black height of every leaf must be same *) val h_inv: t:rbtree' -> Tot bool -let h_inv t = is_Some (black_height t) +let h_inv t = Some? (black_height t) (* * finally, this is the binary search tree invariant @@ -123,15 +123,15 @@ let rec in_tree t k = match t with * may have a red child either on left branch or right branch. *) type not_c_inv (t:rbtree') = - (is_T t) /\ (T.col t = R) /\ (((is_T (T.left t) /\ T.col (T.left t) = R)) \/ - ((is_T (T.right t) /\ T.col (T.right t) = R))) + (T? t) /\ (T?.col t = R) /\ (((T? (T?.left t) /\ T?.col (T?.left t) = R)) \/ + ((T? (T?.right t) /\ T?.col (T?.right t) = R))) (* * in Okasaki's algorithm the re-establishment of invariants takes place * bottom up, meaning although the invariants may be violated at top, * the subtrees still satisfy c_inv. *) -type lr_c_inv (t:rbtree') = is_T t /\ c_inv (T.left t) /\ c_inv (T.right t) +type lr_c_inv (t:rbtree') = T? t /\ c_inv (T?.left t) /\ c_inv (T?.right t) (* * this is the predicate satisfied by a tree before call to balance @@ -143,8 +143,8 @@ type pre_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') = *) ( k_inv lt /\ k_inv rt /\ - (is_E lt \/ (is_T lt /\ ky > (max_elt lt))) /\ - (is_E rt \/ (is_T rt /\ (min_elt rt) > ky)) + (E? lt \/ (T? lt /\ ky > (max_elt lt))) /\ + (E? rt \/ (T? rt /\ (min_elt rt) > ky)) ) /\ @@ -154,7 +154,7 @@ type pre_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') = * the second condition ensures that if resulting tree has (lt k rt), it * satisfies h_inv *) - (h_inv lt /\ h_inv rt /\ Some.v (black_height lt) = Some.v (black_height rt)) + (h_inv lt /\ h_inv rt /\ Some?.v (black_height lt) = Some?.v (black_height rt)) /\ @@ -173,10 +173,10 @@ type pre_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') = type post_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') (r:rbtree') = (* TODO: this should come from requires *) - is_Some (black_height lt) /\ + Some? (black_height lt) /\ (* returned tree is a T tree *) - (is_T r) /\ + (T? r) /\ (* * returned tree satisfies k_inv @@ -185,8 +185,8 @@ type post_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') (r:rbtree') = * (resp. for max elt and rt) *) (k_inv r /\ - ((is_E lt /\ min_elt r = ky) \/ (is_T lt /\ min_elt r = min_elt lt)) /\ - ((is_E rt /\ max_elt r = ky) \/ (is_T rt /\ max_elt r = max_elt rt))) /\ + ((E? lt /\ min_elt r = ky) \/ (T? lt /\ min_elt r = min_elt lt)) /\ + ((E? rt /\ max_elt r = ky) \/ (T? rt /\ max_elt r = max_elt rt))) /\ (* * returned tree satisfies h_inv @@ -195,15 +195,15 @@ type post_balance (c:color) (lt:rbtree') (ky:nat) (rt:rbtree') (r:rbtree') = *) ((h_inv r) /\ - ((c = B /\ Some.v(black_height r) = Some.v(black_height lt) + 1) \/ - (c = R /\ Some.v(black_height r) = Some.v(black_height lt)))) /\ + ((c = B /\ Some?.v(black_height r) = Some?.v(black_height lt) + 1) \/ + (c = R /\ Some?.v(black_height r) = Some?.v(black_height lt)))) /\ (* * returned tree either satisfies c_inv OR - * if it doesn't, it must be the case that c (and hence T.col r) = R + * if it doesn't, it must be the case that c (and hence T?.col r) = R *) (c_inv r \/ - (T.col r = R /\ c = R /\ not_c_inv r /\ lr_c_inv r)) /\ + (T?.col r = R /\ c = R /\ not_c_inv r /\ lr_c_inv r)) /\ (* * resulting tree contains all elements from lt, ly, and rt, and @@ -242,7 +242,7 @@ val ins: t:rbtree' -> k:nat -> (ensures (fun r -> (* returned tree is a T *) - (is_T r) /\ + (T? r) /\ (* * returned tree satisfies k_inv @@ -252,8 +252,8 @@ val ins: t:rbtree' -> k:nat -> *) (k_inv r /\ - (min_elt r = k \/ (is_T t /\ min_elt r = min_elt t)) /\ - (max_elt r = k \/ (is_T t /\ max_elt r = max_elt t))) /\ + (min_elt r = k \/ (T? t /\ min_elt r = min_elt t)) /\ + (max_elt r = k \/ (T? t /\ max_elt r = max_elt t))) /\ (* * returned tree satisfies h_inv @@ -266,7 +266,7 @@ val ins: t:rbtree' -> k:nat -> * these are copied from post condition of balance *) (c_inv r \/ - (is_T t /\ T.col r = R /\ T.col t = R /\ not_c_inv r /\ lr_c_inv r)) /\ + (T? t /\ T?.col r = R /\ T?.col t = R /\ not_c_inv r /\ lr_c_inv r)) /\ (* * returned tree has all the elements of t and k and nothing else @@ -301,7 +301,7 @@ type balanced_rbtree' (t:rbtree') = r_inv t /\ h_inv t /\ c_inv t /\ k_inv t * make black blackens the root of a tree *) val make_black: t:rbtree' -> Pure rbtree' - (requires (is_T t /\ c_inv t /\ h_inv t /\ k_inv t)) + (requires (T? t /\ c_inv t /\ h_inv t /\ k_inv t)) (ensures (fun r -> balanced_rbtree' r /\ (forall k. in_tree t k <==> in_tree r k))) let make_black (T _ a x b) = T B a x b @@ -328,4 +328,4 @@ noeq type rbtree = | Mk: tr:rbtree'{balanced_rbtree' tr} -> rbtree val proj: rbtree -> Pure rbtree' (requires True) (ensures (fun r -> balanced_rbtree' r)) -let proj tr = Mk.tr tr +let proj tr = Mk?.tr tr diff --git a/examples/deriving-monads/exn.fst b/examples/deriving-monads/exn.fst index f6abd6092bb..eb14de80985 100644 --- a/examples/deriving-monads/exn.fst +++ b/examples/deriving-monads/exn.fst @@ -33,8 +33,8 @@ val return: #a:Type -> x:a -> Tot (DExn a (wp_return x)) let return (#a:Type) x _ = V x type wp_bind (#a:Type) (#b:Type) (f:WP a) (g:a -> WP b) : WP b = - fun (post:Post b) -> f (fun r -> (is_E r ==> post (E #b (E.e r))) /\ - (is_V r ==> (g (V.v r)) post)) + fun (post:Post b) -> f (fun r -> (E? r ==> post (E #b (E.e r))) /\ + (V? r ==> (g (V.v r)) post)) val bind: #a:Type -> #b:Type -> #wp1:WP a -> #wp2:(a -> WP b) -> f:DExn a wp1{monotone_WP wp1 /\ (forall x. monotone_WP (wp2 x))} -> g:(x:a -> Tot (DExn b (wp2 x))) @@ -66,17 +66,17 @@ let lemma_bind_assoc (a:Type) (b:Type) (c:Type) (wp1:WP a) (wp2:(a -> WP b)) (wp3:(b -> WP c)) = let _ = assert (forall (post:Post c). wp_bind wp1 (fun (x:a) -> wp_bind (wp2 x) wp3) post <==> - wp1 (fun (r:result a) -> (is_E r ==> post (E #c (E.e r))) /\ - (is_V r ==> wp2 (V.v r) (fun (r':result b) -> (is_E r' ==> post (E #c (E.e r'))) /\ - (is_V r' ==> wp3 (V.v r') post))))) in + wp1 (fun (r:result a) -> (E? r ==> post (E #c (E.e r))) /\ + (V? r ==> wp2 (V.v r) (fun (r':result b) -> (E? r' ==> post (E #c (E.e r'))) /\ + (V? r' ==> wp3 (V.v r') post))))) in - let _ = cut (forall (a:Type) (r:result a{is_E r}) (b:Type). E.e (E #b (E.e r)) = E.e r) in + let _ = cut (forall (a:Type) (r:result a{E? r}) (b:Type). E.e (E #b (E.e r)) = E.e r) in (*let _ = assert (forall (post:Post c). wp_bind (wp_bind wp1 wp2) wp3 post ==> - wp1 (fun (r:result a) -> (is_E r ==> post (E #c (E.e r))) /\ - (is_V r ==> wp2 (V.v r) (fun (r':result b) -> (is_E r' ==> post (E #c (E.e r'))) /\ - (is_V r' ==> wp3 (V.v r') post))))) in + wp1 (fun (r:result a) -> (E? r ==> post (E #c (E.e r))) /\ + (V? r ==> wp2 (V.v r) (fun (r':result b) -> (E? r' ==> post (E #c (E.e r'))) /\ + (V? r' ==> wp3 (V.v r') post))))) in *) admit () diff --git a/examples/dm4free/FStar.DM4F.Continuations.fst b/examples/dm4free/FStar.DM4F.Continuations.fst index ffc65bcce41..8e126a569b7 100644 --- a/examples/dm4free/FStar.DM4F.Continuations.fst +++ b/examples/dm4free/FStar.DM4F.Continuations.fst @@ -90,7 +90,7 @@ let em_wp (a:Type) (forall (x: either a (a -> Tot False)) (post' : False -> Type0). pbpost x post') -let em2 (a:Type) : CONTINUATION.repr (either a (a -> Tot False)) (em_wp a) +let em2 (a:Type) : CONTINUATION?.repr (either a (a -> Tot False)) (em_wp a) = fun (kspec : (either a (a -> Tot False)) -> (False -> Tot Type0) -> Tot Type0) (k : (x:(either a (a -> Tot False))) -> PURE False (kspec x)) -> begin @@ -104,5 +104,5 @@ let em2 (a:Type) : CONTINUATION.repr (either a (a -> Tot False)) (em_wp a) // TODO : to be investigated ./FStar.DM4F.Continuations.fst(19,2-19,3): (Error) assertion failed reifiable let excluded_middle (a:Type) : CONTINUATION (either a (a -> Tot False)) (em_wp a) - = CONTINUATION.reflect (em2 a) + = CONTINUATION?.reflect (em2 a) *) diff --git a/examples/dm4free/FStar.DM4F.Exceptions.fst b/examples/dm4free/FStar.DM4F.Exceptions.fst index 620141e1d6e..fe9309453d6 100644 --- a/examples/dm4free/FStar.DM4F.Exceptions.fst +++ b/examples/dm4free/FStar.DM4F.Exceptions.fst @@ -37,14 +37,14 @@ reifiable reflectable new_effect_for_free { } (* A lift from `Pure´ into the new effect *) -unfold let lift_pure_ex (a:Type) (wp:pure_wp a) (_:unit) (p:EXN.post a) = +unfold let lift_pure_ex (a:Type) (wp:pure_wp a) (_:unit) (p:EXN?.post a) = wp (fun a -> p (Some a)) sub_effect PURE ~> EXN = lift_pure_ex (* An effect to alias easily write pre- and postconditions *) -(* Note: we use Type0 instead of EXN.pre to avoid having to thunk everything. *) -effect Exn (a:Type) (pre:Type0) (post:EXN.post a) = - EXN a (fun (_:unit) (p:EXN.post a) -> pre /\ +(* Note: we use Type0 instead of EXN?.pre to avoid having to thunk everything. *) +effect Exn (a:Type) (pre:Type0) (post:EXN?.post a) = + EXN a (fun (_:unit) (p:EXN?.post a) -> pre /\ (forall (r:option a). (pre /\ post r) ==> p r)) (* Another alias. Ex a is the effect type for total exception-throwing @@ -81,11 +81,11 @@ val div_intrinsic : i:nat -> j:int -> Exn int (requires True) (ensures (function None -> j=0 | Some z -> j<>0 /\ z = i / j)) let div_intrinsic i j = - if j=0 then EXN.raise int + if j=0 then EXN?.raise int else i / j reifiable let div_extrinsic (i:nat) (j:int) : Ex int = - if j=0 then EXN.raise int + if j=0 then EXN?.raise int else i / j let lemma_div_extrinsic (i:nat) (j:int) : @@ -98,9 +98,9 @@ let lemma_div_extrinsic (i:nat) (j:int) : * Here we define raise_ as a pure function working with the * representation of Ex. *) -val raise_ : a:Type -> Tot (EXN.repr a (fun (_:unit) (p:EXN.post a) -> p None)) +val raise_ : a:Type -> Tot (EXN?.repr a (fun (_:unit) (p:EXN?.post a) -> p None)) let raise_ a (_:unit) = None (* We reflect it back to Exn *) reifiable let raise__ (a:Type) : Exn a True (fun r -> r == None) - = EXN.reflect (raise_ a) + = EXN?.reflect (raise_ a) diff --git a/examples/dm4free/FStar.DM4F.ExnSt.fst b/examples/dm4free/FStar.DM4F.ExnSt.fst index a180e457ea7..19fb5bf3e08 100644 --- a/examples/dm4free/FStar.DM4F.ExnSt.fst +++ b/examples/dm4free/FStar.DM4F.ExnSt.fst @@ -38,18 +38,18 @@ reifiable reflectable new_effect_for_free { } (* A lift from Pure *) -unfold let lift_pure_exnst (a:Type) (wp:pure_wp a) (h0:int) (p:EXNST.post a) = +unfold let lift_pure_exnst (a:Type) (wp:pure_wp a) (h0:int) (p:EXNST?.post a) = wp (fun a -> p (Some (a, h0))) sub_effect PURE ~> EXNST = lift_pure_exnst (* A lift from a previously defined state effect *) -val lift_state_exnst_wp : (a:Type) -> IntST.wp a -> EXNST.wp a -let lift_state_exnst_wp a wp (h0:int) (p:EXNST.post a) = +val lift_state_exnst_wp : (a:Type) -> IntST.wp a -> EXNST?.wp a +let lift_state_exnst_wp a wp (h0:int) (p:EXNST?.post a) = wp h0 (fun r -> p (Some r)) val lift_state_exnst : (a:Type) -> (wp:IntST.wp a) -> (f:IntST.repr a wp) -> - EXNST.repr a (lift_state_exnst_wp a wp) + EXNST?.repr a (lift_state_exnst_wp a wp) let lift_state_exnst a wp f = fun h0 -> admit(); Some (f h0) @@ -59,9 +59,9 @@ sub_effect IntST.STINT ~> EXNST { } (* Pre-/postcondition variant *) -effect ExnSt (a:Type) (req:EXNST.pre) (ens:int -> option (a * int) -> GTot Type0) = +effect ExnSt (a:Type) (req:EXNST?.pre) (ens:int -> option (a * int) -> GTot Type0) = EXNST a - (fun (h0:int) (p:EXNST.post a) -> req h0 /\ (forall r. (req h0 /\ ens h0 r) ==> p r)) + (fun (h0:int) (p:EXNST?.post a) -> req h0 /\ (forall r. (req h0 /\ ens h0 r) ==> p r)) (* Total variant *) effect S (a:Type) = @@ -82,13 +82,13 @@ let div_intrinsic i j = if j = 0 then ( (* Despite the incr (implicitly lifted), the state is reset *) IntST.incr (); - EXNST.raise int + EXNST?.raise int ) else i / j reifiable let div_extrinsic (i:nat) (j:int) : S int = if j = 0 then - EXNST.raise int + EXNST?.raise int else i / j diff --git a/examples/dm4free/FStar.DM4F.Heap.ST.fst b/examples/dm4free/FStar.DM4F.Heap.ST.fst index b1c5eafeec9..a7e3ab7556d 100644 --- a/examples/dm4free/FStar.DM4F.Heap.ST.fst +++ b/examples/dm4free/FStar.DM4F.Heap.ST.fst @@ -18,19 +18,19 @@ open FStar.DM4F.ST reifiable reflectable total new_effect_for_free STATE = STATE_h heap -unfold let lift_pure_state (a:Type) (wp:pure_wp a) (h:heap) (p:STATE.post a) = wp (fun a -> p (a, h)) +unfold let lift_pure_state (a:Type) (wp:pure_wp a) (h:heap) (p:STATE?.post a) = wp (fun a -> p (a, h)) sub_effect PURE ~> STATE = lift_pure_state //ST is an abbreviation for STATE with pre- and post-conditions // aka requires and ensures clauses -effect ST (a:Type) (pre: STATE.pre) (post: heap -> a -> heap -> Type0) = +effect ST (a:Type) (pre: STATE?.pre) (post: heap -> a -> heap -> Type0) = STATE a (fun n0 p -> pre n0 /\ (forall a n1. pre n0 /\ post n0 a n1 ==> p (a, n1))) //STNull is an abbreviation for stateful computations with trivial pre/post effect STNull (a:Type) = ST a (fun h -> True) (fun _ _ _ -> True) //////////////////////////////////////////////////////////////////////////////// -//Next, given the primive global state actions STATE.get and STATE.put, +//Next, given the primive global state actions STATE?.get and STATE?.put, //we implement local state operations for allocating, reading and writing refs //////////////////////////////////////////////////////////////////////////////// @@ -43,9 +43,9 @@ let alloc (#a:Type) (init:a) /\ h1 `contains_a_well_typed` r //and is well-typed in h1 /\ sel h1 r == init //initialized to init /\ modifies Set.empty h0 h1)) //and no existing ref is modified - = let h0 = STATE.get () in + = let h0 = STATE?.get () in let r, h1 = alloc h0 init in - STATE.put h1; + STATE?.put h1; r (* Reading, aka dereference *) @@ -56,7 +56,7 @@ let read (#a:Type) (r:ref a) h0 == h1 //heap does not change /\ h1 `contains_a_well_typed` r /\ sel h1 r == v)) //returns the contents of r - = let h0 = STATE.get () in + = let h0 = STATE?.get () in sel h0 r let (!) = read @@ -68,8 +68,8 @@ let write (#a:Type) (r:ref a) (v:a) h0 `contains_a_well_typed` r /\ h1 `contains_a_well_typed` r //the heap remains well-typed /\ h1 == upd h0 r v)) //and is updated at location r only - = let h0 = STATE.get () in - STATE.put (upd h0 r v) + = let h0 = STATE?.get () in + STATE?.put (upd h0 r v) let op_Colon_Equals = write //////////////////////////////////////////////////////////////////////////////// @@ -128,7 +128,7 @@ let rec zero x ghost_heap = if !x = 0 then () else (x := !x - 1; - zero x (STATE.get())) + zero x (STATE?.get())) //////////////////////////////////////////////////////////////////////////////// //An unsafe higher-order example, rightly rejected by an universe inconsistency diff --git a/examples/dm4free/FStar.DM4F.Heap.fst b/examples/dm4free/FStar.DM4F.Heap.fst index 3a678f7bd1d..16ca24ab4f8 100644 --- a/examples/dm4free/FStar.DM4F.Heap.fst +++ b/examples/dm4free/FStar.DM4F.Heap.fst @@ -12,7 +12,7 @@ abstract noeq type pre_heap = { } (* A heap is a pre_heap together with an invariant that nothing is allocated beyond next_addr *) -abstract type heap = h:pre_heap{forall (n:nat). n >= h.next_addr ==> is_None (h.memory n)} +abstract type heap = h:pre_heap{forall (n:nat). n >= h.next_addr ==> None? (h.memory n)} (* References are represented by just their address in the heap *) type ref (a:Type) = nat @@ -25,7 +25,7 @@ abstract let contains_a_well_typed (#a:Type) (h:heap) (r:ref a) : GTot Type0 = (* An abstract predicate for a reference simply being present in memory, usually written infix *) -abstract let contains (h:heap) (r:nat): GTot Type0 = is_Some (h.memory r) +abstract let contains (h:heap) (r:nat): GTot Type0 = Some? (h.memory r) let contains_a_well_typed_implies_contains (#a:Type) (h:heap) (r:ref a) : Lemma (requires (h `contains_a_well_typed` r)) diff --git a/examples/dm4free/FStar.DM4F.IFC.fst b/examples/dm4free/FStar.DM4F.IFC.fst index e4c8c016d0d..6e8ddae2f3c 100644 --- a/examples/dm4free/FStar.DM4F.IFC.fst +++ b/examples/dm4free/FStar.DM4F.IFC.fst @@ -42,11 +42,11 @@ reifiable new_effect_for_free { ; write = write } -effect Ifc (a:Type) (req:IFC.pre) (ens:label -> option (a * label) -> GTot Type0) = - IFC a (fun (h0:label) (p:IFC.post a) -> req h0 /\ +effect Ifc (a:Type) (req:IFC?.pre) (ens:label -> option (a * label) -> GTot Type0) = + IFC a (fun (h0:label) (p:IFC?.post a) -> req h0 /\ (forall r. (req h0 /\ ens h0 r) ==> p r)) -unfold let lift_pure_exnst (a:Type) (wp:pure_wp a) (h0:label) (p:IFC.post a) = +unfold let lift_pure_exnst (a:Type) (wp:pure_wp a) (h0:label) (p:IFC?.post a) = wp (fun a -> p (Some (a, h0))) sub_effect PURE ~> IFC = lift_pure_exnst @@ -57,9 +57,9 @@ let xor (b1:bool) (b2:bool) : Tot bool = not (b1 = b2) val p : unit -> Ifc unit (requires (fun l -> True)) (ensures (fun l r -> r = None)) let p () = - let b1 = IFC.read Low in - let b2 = IFC.read Low in - IFC.write Low (b1 && b2); - let b3 = IFC.read High in - IFC.write High (b1 || b3); - IFC.write Low (xor b3 b3) + let b1 = IFC?.read Low in + let b2 = IFC?.read Low in + IFC?.write Low (b1 && b2); + let b3 = IFC?.read High in + IFC?.write High (b1 || b3); + IFC?.write Low (xor b3 b3) diff --git a/examples/dm4free/FStar.DM4F.IntST.fst b/examples/dm4free/FStar.DM4F.IntST.fst index c7807576a55..e9be6f80afe 100644 --- a/examples/dm4free/FStar.DM4F.IntST.fst +++ b/examples/dm4free/FStar.DM4F.IntST.fst @@ -6,10 +6,10 @@ open FStar.DM4F.ST // Here is where all the DM4F magic happens reifiable reflectable new_effect_for_free STINT = STATE_h int // Some abbreviations -let repr = STINT.repr -let post = STINT.post -let pre = STINT.pre -let wp = STINT.wp +let repr = STINT?.repr +let post = STINT?.post +let pre = STINT?.pre +let wp = STINT?.wp // We define a lift between PURE and STINT // -- this is analogous to the return for the monad @@ -32,24 +32,24 @@ effect StNull (a:Type) = val incr_intrinsic : unit -> StInt unit (requires (fun n -> True)) (ensures (fun n0 _ n1 -> n1 = n0 + 1)) let incr_intrinsic u = - let n = STINT.get () in - STINT.put (n + 1) + let n = STINT?.get () in + STINT?.put (n + 1) // Here is a weaker specification for increment val incr_intrinsic' : unit -> STINT unit (fun s0 post -> forall (s1:int). (s1 > s0) ==> post ((), s1)) let incr_intrinsic' u = - let n = STINT.get () in - STINT.put (n + 1) + let n = STINT?.get () in + STINT?.put (n + 1) // Or, we can give increment the weakest possible spec and prove // properties extrinsically (after the fact) using reification reifiable val incr : unit -> StNull unit let incr u = - let n = STINT.get() in - STINT.put (n + 1) + let n = STINT?.get() in + STINT?.put (n + 1) let incr_increases (s0:int) = assert (snd (reify (incr ()) s0) = s0 + 1) @@ -57,16 +57,16 @@ let incr_increases (s0:int) = assert (snd (reify (incr ()) s0) = s0 + 1) control properties of increment and decrement *) reifiable let decr () : StNull unit = - let n = STINT.get () in - STINT.put (n - 1) + let n = STINT?.get () in + STINT?.put (n - 1) reifiable let ifc (h:bool) : StNull int = - if h then (incr(); let y = STINT.get() in decr(); y) - else STINT.get() + 1 + if h then (incr(); let y = STINT?.get() in decr(); y) + else STINT?.get() + 1 let ni_ifc = assert (forall h0 h1 s0. reify (ifc h0) s0 = reify (ifc h1) s0) -// Although we have STINT.get and STINT.put now as actions, +// Although we have STINT?.get and STINT?.put now as actions, // we can also "rederive" them using reflection val action_get: (u:unit) -> repr int (fun n post -> post (n, n)) @@ -76,32 +76,32 @@ val action_put: x:int -> repr unit (fun n post -> post ((), x)) let action_put x i = ((), x) reifiable val get' : unit -> STINT int (fun z post -> post (z, z)) -let get' () = STINT.reflect (action_get ()) +let get' () = STINT?.reflect (action_get ()) reifiable val put': x:int -> STINT unit (fun z post -> post ((), x)) -let put' x = STINT.reflect (action_put x) +let put' x = STINT?.reflect (action_put x) let assert_after_reify (_:unit) : StNull unit = - let n0 = STINT.get() in + let n0 = STINT?.get() in let _, n1 = reify (incr ()) n0 in assert (n1 = n0 + 1); - STINT.put n1 + STINT?.put n1 val assert_after_reflect : unit -> StNull int let assert_after_reflect u = - let n0 = STINT.get () in + let n0 = STINT?.get () in put' (n0 + 2); - let n1 = STINT.get () in + let n1 = STINT?.get () in assert (n0 + 2 = n1); n1 val reflect_on_the_fly : unit -> StNull int let reflect_on_the_fly u = - let n0 = STINT.get () in + let n0 = STINT?.get () in let add_two : repr unit (fun n post -> post ((), n + 2)) = //need this annotation, since reflect doesn't insert a M.return; but it should fun n0 -> (), n0+2 in - STINT.reflect add_two; - let n1 = STINT.get () in + STINT?.reflect add_two; + let n1 = STINT?.get () in assert (n0 + 2 = n1); n1 diff --git a/examples/dm4free/FStar.DM4F.StExn.fst b/examples/dm4free/FStar.DM4F.StExn.fst index d9c88cddfe9..7bb81b959ca 100644 --- a/examples/dm4free/FStar.DM4F.StExn.fst +++ b/examples/dm4free/FStar.DM4F.StExn.fst @@ -43,13 +43,13 @@ reifiable reflectable new_effect_for_free { } (* A lift from Pure *) -unfold let lift_pure_stexn (a:Type) (wp:pure_wp a) (h0:int) (p:STEXN.post a) = +unfold let lift_pure_stexn (a:Type) (wp:pure_wp a) (h0:int) (p:STEXN?.post a) = wp (fun a -> p (Some a, h0)) sub_effect PURE ~> STEXN = lift_pure_stexn (* Pre-/postcondition variant *) -effect StExn (a:Type) (req:STEXN.pre) (ens:int -> option a -> int -> GTot Type0) = - STEXN a (fun (h0:int) (p:STEXN.post a) -> req h0 /\ +effect StExn (a:Type) (req:STEXN?.pre) (ens:int -> option a -> int -> GTot Type0) = + STEXN a (fun (h0:int) (p:STEXN?.post a) -> req h0 /\ (forall (r:option a) (h1:int). (req h0 /\ ens h0 r h1) ==> p (r, h1))) (* Total variant *) @@ -61,11 +61,11 @@ val div_intrinsic : i:nat -> j:int -> StExn int | None -> h0 = h1 /\ j = 0 | Some z -> h0 = h1 /\ j <> 0 /\ z = i / j)) let div_intrinsic i j = - if j = 0 then STEXN.raise int + if j = 0 then STEXN?.raise int else i / j reifiable let div_extrinsic (i:nat) (j:int) : S int = - if j = 0 then STEXN.raise int + if j = 0 then STEXN?.raise int else i / j let lemma_div_extrinsic (i:nat) (j:int) (h0:int) : diff --git a/examples/dm4free/FStar.DM4F.StExnC.fst b/examples/dm4free/FStar.DM4F.StExnC.fst index 0ab30dc7e8a..1fdc74fcb8a 100644 --- a/examples/dm4free/FStar.DM4F.StExnC.fst +++ b/examples/dm4free/FStar.DM4F.StExnC.fst @@ -45,7 +45,7 @@ reifiable new_effect_for_free { } (* A lift from Pure *) -unfold let lift_pure_stexnc (a:Type) (wp:pure_wp a) (h0:int) (p:STEXNC.post a) = +unfold let lift_pure_stexnc (a:Type) (wp:pure_wp a) (h0:int) (p:STEXNC?.post a) = wp (fun a -> p (Some a, (h0, 0))) sub_effect PURE ~> STEXNC = lift_pure_stexnc @@ -53,10 +53,10 @@ sub_effect PURE ~> STEXNC = lift_pure_stexnc the abstraction of counting exceptions *) (* Pre-/postcondition variant *) -effect StExnC (a:Type) (req:STEXNC.pre) +effect StExnC (a:Type) (req:STEXNC?.pre) (ens:int -> option a -> int -> int -> GTot Type0) = STEXNC a - (fun (h0:int) (p:STEXNC.post a) -> req h0 + (fun (h0:int) (p:STEXNC?.post a) -> req h0 /\ (forall (r:option a) (h1:int) (c:int). (req h0 /\ ens h0 r h1 c) ==> p (r, (h1, c)))) @@ -66,11 +66,11 @@ effect SC (a:Type) = (* This rightfully fails, since STEXNC is not reflectable *) -(* val f_impl : (a:Type) -> STEXNC.repr a (fun h0 post -> post (None, (h0, 0))) *) +(* val f_impl : (a:Type) -> STEXNC?.repr a (fun h0 post -> post (None, (h0, 0))) *) (* let f_impl a = fun h0 -> None, (h0, 0) *) (* let f (a:Type) : STEXNC a (fun h0 post -> post (None, (h0, 0))) = *) -(* STEXNC.reflect (f_impl a) *) +(* STEXNC?.reflect (f_impl a) *) val div_intrinsic : i:nat -> j:int -> StExnC int (requires (fun h -> True)) @@ -78,11 +78,11 @@ val div_intrinsic : i:nat -> j:int -> StExnC int | None -> h0 = h1 /\ c = 1 /\ j = 0 | Some z -> h0 = h1 /\ c = 0 /\ j <> 0 /\ z = i / j)) let div_intrinsic i j = - if j = 0 then STEXNC.raise int + if j = 0 then STEXNC?.raise int else i / j reifiable let div_extrinsic (i:nat) (j:int) : SC int = - if j = 0 then STEXNC.raise int + if j = 0 then STEXNC?.raise int else i / j let lemma_div_extrinsic (i:nat) (j:int) (h0:int) : diff --git a/examples/dm4free/NewPrims.fst b/examples/dm4free/NewPrims.fst index b5826214ec9..a26edfd2c7b 100644 --- a/examples/dm4free/NewPrims.fst +++ b/examples/dm4free/NewPrims.fst @@ -347,10 +347,10 @@ let ex2_return a x p = p (V x) unfold let ex2_bind_wp (r:range) (a:Type) (b:Type) (wp1:ex2_wp a) (wp2:(a -> GTot (ex2_wp b))) = fun p -> - (forall (rb:result b). p rb \/ wp1 (fun ra1 -> if is_V ra1 + (forall (rb:result b). p rb \/ wp1 (fun ra1 -> if V? ra1 then wp2 (V.v ra1) (fun rb2 -> rb2=!=rb) else ~ (ra1 === rb))) - /\ wp1 (fun ra1 -> if is_V ra1 + /\ wp1 (fun ra1 -> if V? ra1 then wp2 (V.v ra1) (fun rb2 -> True) else True) @@ -455,7 +455,7 @@ let all2_return _ a x p = fun h -> p (V x) h unfold let all2_bind_wp (heap:Type) (r:range) (a:Type) (b:Type) (wp1:all2_wp heap a) (wp2:(a -> GTot (all2_wp heap b))) = fun p h0 -> - (wp1 (fun ra h1 -> is_V ra ==> wp2 (V.v ra) p h1) h0) + (wp1 (fun ra h1 -> V? ra ==> wp2 (V.v ra) p h1) h0) val all2_null_wp : heap:Type -> a:Type -> Tot (all2_wp heap a) let all2_null_wp _ a = fun p _ -> forall x h. p x h diff --git a/examples/extraction/Test.ml b/examples/extraction/Test.ml index 54439fbce36..0cc81411b4a 100644 --- a/examples/extraction/Test.ml +++ b/examples/extraction/Test.ml @@ -2,7 +2,7 @@ type ('a, 'b) prod = | Pair of 'a * 'b -let is_Pair = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Pair = (fun ( _discr_ ) -> (match (_discr_) with | Pair (_) -> begin true end @@ -28,7 +28,7 @@ type nnat = | O | S of nnat -let is_O = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_O = (fun ( _discr_ ) -> (match (_discr_) with | O -> begin true end @@ -36,7 +36,7 @@ end false end)) -let is_S = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_S = (fun ( _discr_ ) -> (match (_discr_) with | S (_) -> begin true end @@ -88,7 +88,7 @@ type ('a, ' b) list2 = | Nil2 | Cons2 of 'a * ' b * ('a, ' b) list2 -let is_Nil2 = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Nil2 = (fun ( _discr_ ) -> (match (_discr_) with | Nil2 -> begin true end @@ -96,7 +96,7 @@ end false end)) -let is_Cons2 = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Cons2 = (fun ( _discr_ ) -> (match (_discr_) with | Cons2 (_) -> begin true end @@ -122,7 +122,7 @@ end)) type any = | Any of unit * Obj.t -let is_Any = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Any = (fun ( _discr_ ) -> (match (_discr_) with | Any (_) -> begin true end @@ -142,7 +142,7 @@ type 'a list2p = | Nil2p | Cons2p of 'a * ('a, 'a) prod list2p -let is_Nil2p = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Nil2p = (fun ( _discr_ ) -> (match (_discr_) with | Nil2p -> begin true end @@ -150,7 +150,7 @@ end false end)) -let is_Cons2p = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Cons2p = (fun ( _discr_ ) -> (match (_discr_) with | Cons2p (_) -> begin true end @@ -172,7 +172,7 @@ type 'dummyV1 list3 = | Nil3 of unit | Cons3 of unit * Obj.t * Obj.t list3 -let is_Nil3 = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Nil3 = (fun ( _discr_ ) -> (match (_discr_) with | Nil3 (_) -> begin true end @@ -180,7 +180,7 @@ end false end)) -let is_Cons3 = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Cons3 = (fun ( _discr_ ) -> (match (_discr_) with | Cons3 (_) -> begin true end @@ -201,7 +201,7 @@ end)) type ' x poly = | Poly of nnat * ' x -let is_Poly = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Poly = (fun ( _discr_ ) -> (match (_discr_) with | Poly (_) -> begin true end @@ -238,7 +238,7 @@ type (' a, 'dummyV1) vec = | Nill | Conss of nnat * ' a * (' a, unit) vec -let is_Nill = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Nill = (fun ( _discr_ ) -> (match (_discr_) with | Nill -> begin true end @@ -246,7 +246,7 @@ end false end)) -let is_Conss = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Conss = (fun ( _discr_ ) -> (match (_discr_) with | Conss (_) -> begin true end @@ -276,7 +276,7 @@ type (' t, ' n) naryTree = | Leaf | Node of ((' t, unit) naryTree, unit) vec -let is_Leaf = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Leaf = (fun ( _discr_ ) -> (match (_discr_) with | Leaf -> begin true end @@ -284,7 +284,7 @@ end false end)) -let is_Node = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Node = (fun ( _discr_ ) -> (match (_discr_) with | Node (_) -> begin true end @@ -328,7 +328,7 @@ type ' a evenlist = and ' a oddlist = | OCons of ' a * ' a evenlist -let is_ENil = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_ENil = (fun ( _discr_ ) -> (match (_discr_) with | ENil -> begin true end @@ -336,7 +336,7 @@ end false end)) -let is_ECons = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_ECons = (fun ( _discr_ ) -> (match (_discr_) with | ECons (_) -> begin true end @@ -344,7 +344,7 @@ end false end)) -let is_OCons = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_OCons = (fun ( _discr_ ) -> (match (_discr_) with | OCons (_) -> begin true end @@ -378,7 +378,7 @@ type 'dummyV1 isEven = and 'dummyV1 isOdd = | OddSEven of nnat * unit isEven -let is_Ev0 = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_Ev0 = (fun ( _discr_ ) -> (match (_discr_) with | Ev0 -> begin true end @@ -386,7 +386,7 @@ end false end)) -let is_EvSOdd = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_EvSOdd = (fun ( _discr_ ) -> (match (_discr_) with | EvSOdd (_) -> begin true end @@ -394,7 +394,7 @@ end false end)) -let is_OddSEven = (fun ( _discr_ ) -> (match (_discr_) with +let uu___is_OddSEven = (fun ( _discr_ ) -> (match (_discr_) with | OddSEven (_) -> begin true end @@ -425,7 +425,7 @@ end)) type node = {frequency : int; next : node; zero_child : node ref; one_child : node; symbol : int; code : string} -let is_Mknode = (fun ( _ ) -> (failwith "Not yet implemented:is\x5fMknode")) +let uu___is_Mknode = (fun ( _ ) -> (failwith "Not yet implemented:is\x5fMknode")) let ev2 = EvSOdd (S (O), OddSEven (O, Ev0)) diff --git a/examples/extraction/extTest1.fst b/examples/extraction/extTest1.fst index 023c188d6ef..62c237889cb 100644 --- a/examples/extraction/extTest1.fst +++ b/examples/extraction/extTest1.fst @@ -7,7 +7,7 @@ type nnat = | S : nnat -> nnat val isPositive : nnat -> Tot bool -let isPositive = is_S +let isPositive = S? let idnat = fun (x:nnat) -> x let idnat2 (x:nnat) = x diff --git a/examples/low-level/crypto/Buffer.Utils.fst b/examples/low-level/crypto/Buffer.Utils.fst index df18d4a6916..ac2200f29e4 100644 --- a/examples/low-level/crypto/Buffer.Utils.fst +++ b/examples/low-level/crypto/Buffer.Utils.fst @@ -70,7 +70,7 @@ let lemma_uint32_of_bytes (a:t) (b:t) (c:t) (d:t) : Lemma val uint32_of_bytes: b:bytes{length b >= 4} -> STL u32 (requires (fun h -> live h b)) (ensures (fun h0 r h1 -> h0 == h1 /\ live h0 b - /\ v r = U8 (v (get h0 b 0) + /\ v r = U8.(v (get h0 b 0) + pow2 8 * v (get h0 b 1) + pow2 16 * v (get h0 b 2) + pow2 24 * v (get h0 b 3)) )) diff --git a/examples/low-level/crypto/Crypto.AEAD.Chacha20Poly1305.fst.hints b/examples/low-level/crypto/Crypto.AEAD.Chacha20Poly1305.fst.hints index 259c99da935..38359fc3d66 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Chacha20Poly1305.fst.hints +++ b/examples/low-level/crypto/Crypto.AEAD.Chacha20Poly1305.fst.hints @@ -61,15 +61,15 @@ "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_21893ebac39ffe3843ed7549f5268261", "refinement_interpretation_Tm_refine_907182d4e2170b57b8441f948a734676", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.Mk.v", "typing_FStar.UInt32.v", - "typing_Prims.pow2" + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.__proj__Mk__item__v", + "typing_FStar.UInt32.v", "typing_Prims.pow2" ], 0 ], @@ -113,19 +113,23 @@ 0, 1, [ - "@query", "b2t_def", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.Chacha20.blocklen", - "equation_FStar.UInt.fits", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "@query", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "fuel_guarded_inversion_FStar.UInt32.t_", - "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", - "int_inversion", "int_typing", "lemma_FStar.Buffer.lemma_size", - "primitive_Prims.op_AmpAmp", "proj_equation_FStar.UInt32.Mk_v", - "projection_inverse_BoxBool_proj_0", + "equation_FStar.UInt32.v", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", + "int_typing", "lemma_FStar.Buffer.lemma_size", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", - "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d" + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v" ], 0 ], @@ -135,15 +139,23 @@ 0, 1, [ - "@query", "data_elim_FStar.UInt32.Mk", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "fuel_guarded_inversion_FStar.UInt32.t_", "int_inversion", + "@query", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "int_typing", "lemma_FStar.Buffer.lemma_size", - "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", - "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d" + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v" ], 0 ], diff --git a/examples/low-level/crypto/Crypto.AEAD.Encoding.fst b/examples/low-level/crypto/Crypto.AEAD.Encoding.fst index dfe3ce095b6..afbb6d105f5 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Encoding.fst +++ b/examples/low-level/crypto/Crypto.AEAD.Encoding.fst @@ -341,7 +341,7 @@ val accumulate: aadlen:UInt32.t -> aad:lbuffer (v aadlen) -> plainlen:UInt32.t -> cipher:lbuffer (v plainlen) -> StackInline (MAC.itext * MAC.accB i) (requires (fun h0 -> - MAC(Buffer.live h0 st.r /\ norm h0 st.r) /\ + MAC.(Buffer.live h0 st.r /\ norm h0 st.r) /\ Buffer.live h0 aad /\ Buffer.live h0 cipher)) (ensures (fun h0 (l,a) h1 -> Buffer.modifies_0 h0 h1 /\ // modifies only fresh buffers on the current stack diff --git a/examples/low-level/crypto/Crypto.AEAD.Invariant.fst b/examples/low-level/crypto/Crypto.AEAD.Invariant.fst index 9a60f1e44e4..db51c11f097 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Invariant.fst +++ b/examples/low-level/crypto/Crypto.AEAD.Invariant.fst @@ -30,7 +30,7 @@ let minNat (a:nat) (b:nat) : nat = if a <= b then a else b type region = rgn:HH.rid {HS.is_eternal_region rgn} -let ctr x = PRF(x.ctr) +let ctr x = PRF.(x.ctr) //16-10-12 TEMPORARY, while PRF remains somewhat CHACHA-specific //16-10-12 NB we are importing this restriction from Encoding too @@ -51,8 +51,8 @@ noeq type state (i:id) (rw:rw) = | State: #log_region: rgn -> // this is the *writer* region; the reader allocates nothing log: HS.ref (Seq.seq (entry i)) {HS.frameOf log == log_region} -> - // Was PRF(prf.rgn) == region. Do readers use its own PRF state? - prf: PRF.state i {PRF(prf.rgn) == log_region} (* including its key *) -> + // Was PRF.(prf.rgn) == region. Do readers use its own PRF state? + prf: PRF.state i {PRF.(prf.rgn) == log_region} (* including its key *) -> //16-10-16 ak: MAC.akey log_region i (* static, optional authentication key *) -> state i rw @@ -62,8 +62,8 @@ let maxplain (i:id) = pow2 14 // for instance let safelen (i:id) (l:nat) (c:UInt32.t{0ul <^ c /\ c <=^ PRF.maxCtr i}) = l = 0 || ( - let bl = v (Cipher( blocklen (cipher_of_id i))) in - FStar.Mul( + let bl = v (Cipher.( blocklen (cipher_of_id i))) in + FStar.Mul.( l + (v (c -^ 1ul)) * bl <= maxplain i && l <= v (PRF.maxCtr i -^ c) * bl )) @@ -80,10 +80,10 @@ val counterblocks: to_pos:nat{from_pos <= to_pos /\ to_pos <= l /\ safelen i (to_pos - from_pos) (ctr x)} -> plain:Plain.plain i l -> cipher:lbytes l -> - Tot (Seq.seq (PRF.entry rgn i)) // each entry e {PRF(e.x.id = x.iv /\ e.x.ctr >= ctr x)} + Tot (Seq.seq (PRF.entry rgn i)) // each entry e {PRF.(e.x.id = x.iv /\ e.x.ctr >= ctr x)} (decreases (to_pos - from_pos)) let rec counterblocks i rgn x l from_pos to_pos plain cipher = - let blockl = v (Cipher(blocklen (cipher_of_id i))) in + let blockl = v (Cipher.(blocklen (cipher_of_id i))) in let remaining = to_pos - from_pos in if remaining = 0 then Seq.createEmpty @@ -97,7 +97,7 @@ let rec counterblocks i rgn x l from_pos to_pos plain cipher = SeqProperties.cons block blocks let num_blocks' (i:id) (l:nat) : Tot nat = - let bl = v (Cipher( blocklen (cipher_of_id i))) in + let bl = v (Cipher.( blocklen (cipher_of_id i))) in (l + bl - 1) / bl #reset-options "--z3rlimit 20" @@ -111,16 +111,16 @@ let refines_one_entry (#rgn:region) (#i:id{safeId i}) (h:mem) (e:entry i) (block let b = num_blocks e in b + 1 = Seq.length blocks /\ (let PRF.Entry x e = Seq.index blocks 0 in - PRF (x.iv = nonce) /\ - PRF (x.ctr = 0ul) /\ ( + PRF.(x.iv = nonce) /\ + PRF.(x.ctr = 0ul) /\ ( let xors = Seq.slice blocks 1 (b+1) in let cipher, tag = SeqProperties.split cipher_tagged l in safelen i l 1ul /\ xors == counterblocks i rgn (PRF.incr i x) l 0 l plain cipher /\ //NS: forced to use propositional equality here, since this compares sequences of abstract plain texts. CF 16-10-13: annoying, but intuitively right? (let m = PRF.macRange rgn i x e in - let mac_log = MAC.ilog (MAC.State.log m) in + let mac_log = MAC.ilog (MAC.State?.log m) in m_contains mac_log h /\ ( - match m_sel h (MAC.ilog (MAC.State.log m)) with + match m_sel h (MAC.ilog (MAC.State?.log m)) with | None -> False | Some (msg,tag') -> msg = field_encode i ad #(FStar.UInt32.uint_to_t l) cipher /\ tag = tag')))) //NS: adding this bit to relate the tag in the entries to the tag in that MAC log diff --git a/examples/low-level/crypto/Crypto.AEAD.Lemmas.Part2.fst b/examples/low-level/crypto/Crypto.AEAD.Lemmas.Part2.fst index 6e9f219dd4a..3d8a266fb86 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Lemmas.Part2.fst +++ b/examples/low-level/crypto/Crypto.AEAD.Lemmas.Part2.fst @@ -130,7 +130,7 @@ let prf_enxor_leaves_none_strictly_above_x #i t x len remaining_len c h_0 h_1 let rgn = t.mac_rgn in assert (find t_0 x == None); find_snoc t_0 ex (fun (e:PRF.entry rgn i) -> e.x = x); - assert (is_Some (find t_1 x)); + assert (Some? (find t_1 x)); assert (find t_1 x == Some ex.range); let y = PRF.incr i x in assert (find t_0 y == None) diff --git a/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst b/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst index e9704de44a8..5cb3ef245ed 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst +++ b/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst @@ -31,8 +31,8 @@ abstract let pre_refines_one_entry (rgn:region) (i:id{safeId i}) (h:mem) (l:nat{ let b = num_blocks' i l in b + 1 = Seq.length blocks /\ (let PRF.Entry x e = Seq.index blocks 0 in - PRF (x.iv = nonce) /\ - PRF (x.ctr = 0ul) /\ ( + PRF.(x.iv = nonce) /\ + PRF.(x.ctr = 0ul) /\ ( let xors = Seq.slice blocks 1 (b+1) in let cipher, tag = SeqProperties.split c_tagged l in safelen i l 1ul /\ @@ -56,9 +56,9 @@ let mac_refines (i:id) match PRF.find_mac tab x0 with | None -> False | Some m -> - let mac_log = MAC.ilog (MAC.State.log m) in + let mac_log = MAC.ilog (MAC.State?.log m) in m_contains mac_log h /\ ( - match m_sel h (MAC.ilog (MAC.State.log m)) with + match m_sel h (MAC.ilog (MAC.State?.log m)) with | None -> False | Some (msg,tag') -> msg = field_encode i ad #(u len) c /\ tag = tag'))) @@ -80,8 +80,8 @@ let intro_mac_refines (i:id) (st:state i Writer) (nonce: Cipher.iv (alg i)) match PRF.find_mac tab x0 with | None -> False | Some mac_st -> - m_contains (MAC (ilog mac_st.log)) h /\ - m_sel h (MAC (ilog mac_st.log)) == Some (l, Buffer.as_seq h tagB))))) + m_contains (MAC.(ilog mac_st.log)) h /\ + m_sel h (MAC.(ilog mac_st.log)) == Some (l, Buffer.as_seq h tagB))))) (ensures mac_refines i st nonce aad plain cipher h) = () @@ -141,7 +141,7 @@ val counterblocks_len: #i:id{safeId i} -> let rec counterblocks_len #i rgn x len from_pos plain cipher = if from_pos = len then () - else let blockl = v (Cipher(blocklen (cipher_of_id i))) in + else let blockl = v (Cipher.(blocklen (cipher_of_id i))) in let remaining = len - from_pos in let l0 = minNat remaining blockl in counterblocks_len #i rgn (PRF.incr i x) len (from_pos + l0) plain cipher @@ -159,7 +159,7 @@ let intro_refines_one_entry_no_tag let table_2 = HS.sel h2 (PRF.itable i st.prf) in let initial_domain = {iv=nonce; ctr=1ul} in let c, _ = SeqProperties.split c_tagged len in - (exists mac. Seq.equal table_1 (SeqProperties.snoc table_0 (PRF (Entry ({iv=nonce; ctr=0ul}) mac)))) /\ + (exists mac. Seq.equal table_1 (SeqProperties.snoc table_0 (PRF.(Entry ({iv=nonce; ctr=0ul}) mac)))) /\ safelen i len 1ul /\ table_2 == (Seq.append table_1 (counterblocks i mac_rgn initial_domain len 0 len p c))))) (ensures (safeId i /\ prf i ==> @@ -251,7 +251,7 @@ let frame_refines_one_entry (h:mem) (i:id{safeId i}) (mac_rgn:region) (ensures refines_one_entry h' e blocks) = let PRF.Entry x rng = Seq.index blocks 0 in let m = PRF.macRange mac_rgn i x rng in - let mac_log = MAC.ilog (MAC.State.log m) in + let mac_log = MAC.ilog (MAC.State?.log m) in assert (m_sel h mac_log = m_sel h' mac_log); assert (m_contains mac_log h') //this include HS.live_region, which is not derivable from modifies_ref along @@ -315,7 +315,7 @@ let rec counterblocks_snoc (#i:id{safeId i}) (rgn:region) (x:domain i{x.ctr <> 0 (len:nat{len <> 0 /\ safelen i len 1ul}) (next:nat{0 < next /\ next <= v (PRF.blocklen i)}) (completed_len:nat{ completed_len + next <= len /\ - FStar.Mul ((k - 1) * v (PRF.blocklen i) = completed_len)}) + FStar.Mul.((k - 1) * v (PRF.blocklen i) = completed_len)}) (plain:Plain.plain i len) (cipher:lbytes len) : Lemma (requires True) @@ -403,7 +403,7 @@ let rec counterblocks_slice #i rgn x len from_pos to_pos plain cipher val frame_counterblocks_snoc: i:id{safeId i} -> (t:PRF.state i) -> (x:domain i{x.ctr <> 0ul}) -> k:nat{v x.ctr <= k} -> len:nat{len <> 0 /\ safelen i len 1ul} -> (completed_len:nat{completed_len < len /\ - FStar.Mul ((k - 1) * v (PRF.blocklen i) = completed_len)}) -> + FStar.Mul.((k - 1) * v (PRF.blocklen i) = completed_len)}) -> (plain:plainBuffer i len) -> (cipher:lbuffer len) -> (h0:mem{Plain.live h0 plain /\ @@ -459,7 +459,7 @@ let frame_counterblocks_snoc i t x k len completed_len plain cipher h0 h1 = val extending_counter_blocks: #i:id -> (t:PRF.state i) -> (x:domain i{x.ctr <> 0ul}) -> len:nat{len <> 0 /\ safelen i len 1ul} -> (completed_len:nat{completed_len < len /\ - FStar.Mul ((v x.ctr - 1) * v (PRF.blocklen i) = completed_len)}) -> + FStar.Mul.((v x.ctr - 1) * v (PRF.blocklen i) = completed_len)}) -> (plain:plainBuffer i len) -> (cipher:lbuffer len) -> (h0:mem{Plain.live h0 plain /\ diff --git a/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst.hints b/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst.hints index 7d7a37855e1..54da9351923 100644 --- a/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst.hints +++ b/examples/low-level/crypto/Crypto.AEAD.Lemmas.fst.hints @@ -1,5 +1,5 @@ [ - "P0c#4Y)", + "VO\\j\u0011\u00133i", [ [ "Crypto.AEAD.Lemmas.u", @@ -18,6 +18,7 @@ "@query", "b2t_def", "bool_inversion", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", + "data_elim_Crypto.Symmetric.PRF.Mkdomain", "data_elim_FStar.UInt32.Mk", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", @@ -27,18 +28,22 @@ "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", + "equation_Crypto.AEAD.Invariant.maxplain", "equation_Crypto.AEAD.Invariant.num_blocks_", "equation_Crypto.AEAD.Invariant.region", "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.bytes", "equation_Crypto.Symmetric.Bytes.lbytes", + "equation_Crypto.Symmetric.Bytes.u32", "equation_Crypto.Symmetric.Chacha20.blocklen", "equation_Crypto.Symmetric.Cipher.blocklen", "equation_Crypto.Symmetric.Cipher.iv", "equation_Crypto.Symmetric.PRF.blocklen", + "equation_Crypto.Symmetric.PRF.ctrT", "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.incr", "equation_Crypto.Symmetric.PRF.maxCtr", @@ -64,20 +69,23 @@ "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", "equation_Flag.mac1", "equation_Prims.nat", "fuel_guarded_inversion_Crypto.Symmetric.Cipher.alg", + "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_FStar.UInt128.t_", + "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", - "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Seq.lemma_len_slice", - "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_Division", - "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", + "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", + "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", @@ -90,21 +98,24 @@ "refinement_interpretation_Tm_refine_4ee9db8af45528c0331cbf2c06a48bfc", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "typing_Crypto.AEAD.Encoding.alg", "typing_Crypto.AEAD.Invariant.num_blocks_", "typing_Crypto.Symmetric.AES.v", + "typing_Crypto.Symmetric.Cipher.blocklen", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.length", - "typing_FStar.UInt.fits", "typing_Flag.mac1", - "typing_Flag.mac_int1cma", "typing_Flag.mac_of_id", - "typing_Flag.safeHS" + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", + "typing_Flag.mac1", "typing_Flag.mac_int1cma", + "typing_Flag.mac_of_id", "typing_Flag.safeHS" ], 0 ], @@ -227,7 +238,6 @@ "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.maxCtr", "equation_Crypto.Symmetric.PRF.region", - "equation_Crypto.Symmetric.PRF.smac", "equation_Crypto.Symmetric.Poly1305.MAC.itext", "equation_Crypto.Symmetric.Poly1305.MAC.log", "equation_Crypto.Symmetric.Poly1305.MAC.text_0", @@ -257,7 +267,6 @@ "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", "function_token_typing_Crypto.Symmetric.Poly1305.Spec.word_16", @@ -284,27 +293,25 @@ "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_7148cbb104ff25a5758faf4b8b8d55af", - "refinement_interpretation_Tm_refine_7dfe2c086ce4a9ddf1ee973143c525a4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_b5894c907e21e41ad2bb4e26bfc7310f", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_eb8f0a0ac9d8793518e02704d205443b", "typing_Crypto.AEAD.Encoding.alg", - "typing_Crypto.AEAD.Invariant.State.prf", + "typing_Crypto.AEAD.Invariant.__proj__State__item__prf", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_Crypto.Symmetric.PRF.smac", - "typing_FStar.Buffer.MkBuffer.length", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.length", "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", - "typing_FStar.UInt32.v", "typing_Flag.safeHS", - "typing_Plain.as_buffer", "typing_Prims.is_None", - "typing_tok_Crypto.AEAD.Invariant.Writer@tok" + "typing_FStar.UInt32.v", "typing_Plain.as_buffer", + "typing_Prims.is_Some", "typing_tok_Crypto.AEAD.Invariant.Writer@tok" ], 0 ], @@ -412,8 +419,6 @@ "equation_Crypto.Symmetric.PRF.region", "equation_Crypto.Symmetric.PRF.smac", "equation_Crypto.Symmetric.Poly1305.MAC.itext", - "equation_Crypto.Symmetric.Poly1305.MAC.text_0", - "equation_Crypto.Symmetric.Poly1305.Spec.elem", "equation_Crypto.Symmetric.Poly1305.Spec.tag", "equation_Crypto.Symmetric.Poly1305.Spec.taglen", "equation_Crypto.Symmetric.Poly1305.Spec.text", @@ -433,37 +438,34 @@ "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", - "equation_Flag.cipher_of_id", "equation_Flag.prf", - "equation_Plain.as_buffer", "equation_Plain.plainLen", - "equation_Prims._assert", "equation_Prims.l_False", - "equation_Prims.l_and", "equation_Prims.nat", + "equation_Flag.cipher_of_id", "equation_Plain.as_buffer", + "equation_Plain.plainLen", "equation_Prims._assert", + "equation_Prims.l_False", "equation_Prims.l_and", + "equation_Prims.nat", "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt128.t_", "fuel_guarded_inversion_FStar.UInt32.t_", - "fuel_guarded_inversion_Prims.option", "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.GF128.len", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", - "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", "kinding_FStar.UInt8.t_@tok", "l_and-interp", "l_imp-interp", "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.lemma_sub_spec", - "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_len_slice", - "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.mac1_implies_prf", - "lemma_Flag.safeId_implies_mac1", "lemma_Prims.invertOption", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Division", "primitive_Prims.op_Equality", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", + "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", + "lemma_Prims.invertOption", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", + "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_Crypto.AEAD.Invariant.State_prf", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", + "proj_equation_Crypto.Symmetric.PRF.Mkdomain_iv", "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.Buffer.MkBuffer_idx", "proj_equation_FStar.Buffer.MkBuffer_length", @@ -472,6 +474,7 @@ "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_ctr", + "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_iv", "projection_inverse_FStar.Buffer.MkBuffer_idx", "projection_inverse_FStar.UInt32.Mk_v", "projection_inverse_Prims.Mktuple2__1", @@ -480,6 +483,7 @@ "projection_inverse_Prims.Mktuple2__b", "projection_inverse_Prims.Some_a", "projection_inverse_Prims.Some_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0991f788dbb220993dffda8c3c28b9ce", "refinement_interpretation_Tm_refine_1a08b5d05b59e54c057d77b8fdcf6ba6", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", @@ -488,32 +492,28 @@ "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_7148cbb104ff25a5758faf4b8b8d55af", "refinement_interpretation_Tm_refine_7874c81428902f5ef0683ead2eab5830", - "refinement_interpretation_Tm_refine_7dfe2c086ce4a9ddf1ee973143c525a4", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_b5894c907e21e41ad2bb4e26bfc7310f", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", - "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_deb68a2ba9316e7f1502cc670399a37c", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", - "typing_Crypto.AEAD.Invariant.State.prf", + "refinement_interpretation_Tm_refine_eb8f0a0ac9d8793518e02704d205443b", + "typing_Crypto.AEAD.Invariant.__proj__State__item__prf", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_Crypto.Symmetric.PRF.smac", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", - "typing_FStar.Buffer.as_seq", "typing_FStar.Seq.createEmpty", - "typing_FStar.Seq.length", "typing_FStar.UInt.fits", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.Buffer.as_seq", "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.v", - "typing_Flag.prf", "typing_Flag.safeHS", "typing_Flag.safeId", - "typing_Plain.as_buffer", "typing_Prims.is_Some", - "typing_tok_Crypto.AEAD.Invariant.Writer@tok" + "typing_Flag.safeHS", "typing_Flag.safeId", "typing_Plain.as_buffer", + "typing_Prims.is_None", "typing_tok_Crypto.AEAD.Invariant.Writer@tok" ], 0 ], @@ -567,10 +567,9 @@ "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.buffer", - "equation_Crypto.Symmetric.Bytes.bytes", "equation_Crypto.Symmetric.Bytes.lbuffer", - "equation_Crypto.Symmetric.Bytes.lbytes", "equation_Crypto.Symmetric.Bytes.mem", + "equation_Crypto.Symmetric.Bytes.sel_bytes", "equation_Crypto.Symmetric.Poly1305.Spec.taglen", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.length", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.lte", @@ -599,15 +598,14 @@ "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_7148cbb104ff25a5758faf4b8b8d55af", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", - "refinement_interpretation_Tm_refine_a917a802cdb0c45fe1a8176d288f4ee0", + "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.Bytes.sel_bytes", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.as_seq", "typing_FStar.UInt32.v", "typing_Plain.as_buffer" ], 0 @@ -682,11 +680,11 @@ 1, 1, [ - "@query", "b2t_def", "bool_inversion", "bool_typing", - "data_elim_FStar.UInt32.Mk", "equation_Crypto.AEAD.Encoding.id", + "@query", "b2t_def", "bool_inversion", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", - "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", @@ -704,33 +702,35 @@ "equation_FStar.UInt32.v", "equation_Prims.nat", "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_FStar.UInt32.v", "int_inversion", "int_typing", "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_df88580d7d9187a9eeb551e25bb9d328", + "refinement_interpretation_Tm_refine_c69cb0aff953d224edd392abfe96b7b3", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", "token_correspondence_FStar.UInt32.v", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v" + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.uint_to_t", + "typing_FStar.UInt32.v" ], 0 ], @@ -742,24 +742,19 @@ [ "@query", "b2t_def", "binder_x_067229a5d1b0064630d2c0f8961363af_6", "binder_x_0f1e3ab1674b3cc07b69bf3eb488501e_0", - "binder_x_26f427d8cb86e5d2cae2fd0b3516fd5a_4", + "binder_x_13f60c6627ee390d474193437674e286_4", "binder_x_2a6d7f92917330a9aad78e30231f1666_5", + "binder_x_308adbeaf3713c717a8ebb80ef253d59_2", "binder_x_969dc8d3c9471a0b164930f39e5fe8fa_1", - "binder_x_a51c1c074dfd6f78d4c51867b62b79be_3", - "binder_x_ae3ff8db64426bd7628dfe396bf30c78_2", "bool_inversion", - "bool_typing", + "binder_x_a51c1c074dfd6f78d4c51867b62b79be_3", "bool_inversion", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", - "constructor_distinct_Tm_unit", - "data_elim_Crypto.Symmetric.PRF.Mkdomain", "data_elim_FStar.UInt32.Mk", "data_typing_intro_Crypto.Symmetric.PRF.Entry@tok", "data_typing_intro_Crypto.Symmetric.PRF.OTP@tok", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", - "equality_tok_Prims.LexTop@tok", - "equation_Crypto.AEAD.Encoding.aadmax", - "equation_Crypto.AEAD.Encoding.id", + "equality_tok_Prims.LexTop@tok", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.AEAD.Invariant.maxplain", @@ -768,7 +763,6 @@ "equation_Crypto.AEAD.Invariant.region", "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.Symmetric.AES.keylen", - "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.bytes", @@ -786,13 +780,12 @@ "equation_FStar.HyperStack.is_eternal_region", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.cons", "equation_FStar.UInt.add", - "equation_FStar.UInt.div", "equation_FStar.UInt.fits", - "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", - "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", - "equation_FStar.UInt.size", "equation_FStar.UInt.sub", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.add", - "equation_FStar.UInt32.div", "equation_FStar.UInt32.gt", + "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", + "equation_FStar.UInt.lt", "equation_FStar.UInt.lte", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.add", "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lt", "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", @@ -806,8 +799,8 @@ "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_FStar.UInt32.t_", "fuel_irrelevance_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", - "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_FStar.UInt32.v", @@ -815,7 +808,7 @@ "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", "kinding_Crypto.Symmetric.PRF.entry@tok", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", - "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_create_len", + "lemma_FStar.Seq.lemma_create_len", "lemma_FStar.Seq.lemma_len_append", "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", @@ -831,43 +824,42 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_ctr", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_16b4cd6b9a8ec288d9451e6c94b17757", + "refinement_interpretation_Tm_refine_05d64f82518629f574329e4072aa8f5e", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", - "refinement_interpretation_Tm_refine_483dc77ca24c6e237a3b81844b5079c4", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", + "refinement_interpretation_Tm_refine_6a5867b104f74ce2c827af3a70b1d25b", "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", + "refinement_interpretation_Tm_refine_6df067e69a2c35036b5687363e82e2ba", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a93f84e364f30647151ce528fc3c7b9a", "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", - "refinement_interpretation_Tm_refine_e8a3b061c144fe07c532f73daf3668ea", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", "token_correspondence_FStar.UInt32.v", "typing_Crypto.AEAD.Invariant.counterblocks", + "typing_Crypto.AEAD.Invariant.num_blocks_", "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.Cipher.blocklen", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.length", "typing_FStar.Seq.slice", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.add", "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", "typing_Flag.mac1", "typing_Flag.mac_int1cma", "typing_Flag.mac_of_id", "typing_Flag.safeHS", "typing_Flag.safeId", "typing_Plain.slice", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -879,8 +871,8 @@ [ "@query", "assumption_Prims.HasEq_int", "binder_x_0f1e3ab1674b3cc07b69bf3eb488501e_0", - "binder_x_969dc8d3c9471a0b164930f39e5fe8fa_1", - "binder_x_ae3ff8db64426bd7628dfe396bf30c78_2", "bool_inversion", + "binder_x_308adbeaf3713c717a8ebb80ef253d59_2", + "binder_x_969dc8d3c9471a0b164930f39e5fe8fa_1", "bool_inversion", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.AEAD.Invariant.region", @@ -893,36 +885,34 @@ "equation_Crypto.Symmetric.PRF.maxCtr", "equation_FStar.HyperStack.is_eternal_region", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.lt", - "equation_FStar.UInt.mul", "equation_FStar.UInt.sub", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.lt", - "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.lt", "equation_FStar.UInt32.lte", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_Prims.nat", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_FStar.UInt32.v", - "haseqTm_refine_90e11659295f4a3049ddb473f19ff47b", + "haseqTm_refine_029563a4404c812933042bc425210e7e", "haseqTm_refine_ba523126f67e00e7cd55f0b92f16681d", "int_inversion", "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_LessThan", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", - "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_a93f84e364f30647151ce528fc3c7b9a", + "refinement_interpretation_Tm_refine_6a5867b104f74ce2c827af3a70b1d25b", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "token_correspondence_FStar.UInt32.v", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.UInt32.lte" @@ -938,9 +928,10 @@ "@query", "b2t_def", "bool_inversion", "bool_typing", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", - "constructor_distinct_Prims.Mktuple2", "data_elim_FStar.UInt32.Mk", + "data_elim_Crypto.Symmetric.PRF.Entry", "data_elim_FStar.UInt32.Mk", "data_typing_intro_Crypto.Symmetric.PRF.Entry@tok", "data_typing_intro_Crypto.Symmetric.PRF.Mkdomain@tok", + "data_typing_intro_Crypto.Symmetric.PRF.OTP@tok", "equality_tok_Crypto.AEAD.Invariant.Writer@tok", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", @@ -949,6 +940,8 @@ "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", + "equation_Crypto.AEAD.Invariant.maxplain", + "equation_Crypto.AEAD.Invariant.minNat", "equation_Crypto.AEAD.Invariant.num_blocks_", "equation_Crypto.AEAD.Invariant.region", "equation_Crypto.AEAD.Invariant.safelen", @@ -973,16 +966,18 @@ "equation_Crypto.Symmetric.PRF.incr", "equation_Crypto.Symmetric.PRF.itable", "equation_Crypto.Symmetric.PRF.maxCtr", + "equation_Crypto.Symmetric.PRF.range", "equation_Crypto.Symmetric.PRF.region", "equation_Crypto.Symmetric.Poly1305.MAC.itext", "equation_Crypto.Symmetric.Poly1305.MAC.text_0", "equation_Crypto.Symmetric.Poly1305.Spec.elem", "equation_Crypto.Symmetric.Poly1305.Spec.taglen", "equation_Crypto.Symmetric.Poly1305.Spec.text", - "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.length", "equation_FStar.HyperStack.ref", - "equation_FStar.HyperStack.sel", "equation_FStar.List.Tot.test_sort", - "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.snoc", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.length", + "equation_FStar.HyperStack.ref", "equation_FStar.HyperStack.sel", + "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", + "equation_FStar.SeqProperties.cons", + "equation_FStar.SeqProperties.snoc", "equation_FStar.SeqProperties.split", "equation_FStar.UInt.add", "equation_FStar.UInt.div", "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", @@ -995,10 +990,12 @@ "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", - "equation_Flag.cipher_of_id", "equation_Flag.prf", - "equation_Plain.as_buffer", "equation_Plain.plainLen", + "equation_FStar.UInt32.v", "equation_FStar.UInt64.n", + "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", + "equation_Flag.prf", "equation_Plain.as_buffer", + "equation_Plain.plainLen", "equation_Plain.slice", "equation_Prims._assert", "equation_Prims.nat", + "equation_with_fuel_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", "fuel_guarded_inversion_Crypto.Symmetric.PRF.entry", @@ -1014,24 +1011,30 @@ "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", "function_token_typing_FStar.HyperStack.sel", "function_token_typing_FStar.List.Tot.test_sort", + "function_token_typing_FStar.Seq.append", + "function_token_typing_FStar.UInt32.v", + "function_token_typing_FStar.UInt64.n", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", + "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", "interpretation_Tm_arrow_f0b351470a18acd6427601c7e29d4a6b", + "interpretation_Tm_arrow_fccf4cd01e79ad2183fa51e7725fb9d9", "kinding_Crypto.Symmetric.PRF.entry@tok", "kinding_FStar.UInt8.t_@tok", "l_and-interp", - "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Seq.lemma_create_len", - "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.Seq.lemma_eq_intro", - "lemma_FStar.Seq.lemma_index_app1", + "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Int.pow2_values", + "lemma_FStar.Seq.lemma_create_len", "lemma_FStar.Seq.lemma_eq_elim", + "lemma_FStar.Seq.lemma_eq_intro", "lemma_FStar.Seq.lemma_index_app1", "lemma_FStar.Seq.lemma_index_app2", "lemma_FStar.Seq.lemma_index_create", "lemma_FStar.Seq.lemma_index_slice", "lemma_FStar.Seq.lemma_len_append", "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", - "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Division", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", + "pretyping_533d8a9fddfb9ab2d24280a2b80ade9f", + "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_BarBar", "primitive_Prims.op_Division", + "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_Crypto.AEAD.Invariant.State_prf", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_iv", @@ -1044,9 +1047,6 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_iv", "projection_inverse_FStar.UInt32.Mk_v", "projection_inverse_Prims.Mktuple2__1", - "projection_inverse_Prims.Mktuple2__2", - "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_04db70ec1d384002bbc56507e73bf0d7", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", @@ -1054,44 +1054,59 @@ "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_4ee9db8af45528c0331cbf2c06a48bfc", + "refinement_interpretation_Tm_refine_517edd6681fd1e8aba97c31c41dc4514", "refinement_interpretation_Tm_refine_5ec5b64a8a200c47ed44dad76f0de705", "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", + "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", - "refinement_interpretation_Tm_refine_7dfe2c086ce4a9ddf1ee973143c525a4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9579fa2db1a51848d754cc29acdc2303", + "refinement_interpretation_Tm_refine_9b9201ccbfd99139a24c221142f1d58d", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_9d836f17260390394ee04e04c2340c0e", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_a57b551dc0f312d391aa44f548d97477", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", - "refinement_interpretation_Tm_refine_b15dc250df6ac242c7d2a33a77c3908d", + "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", + "refinement_interpretation_Tm_refine_b5894c907e21e41ad2bb4e26bfc7310f", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_d0706cacf28775ed6d73df6c7a971e6a", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", + "refinement_interpretation_Tm_refine_e8a3b061c144fe07c532f73daf3668ea", + "refinement_interpretation_Tm_refine_eb8f0a0ac9d8793518e02704d205443b", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", + "token_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "token_correspondence_FStar.HyperStack.sel", - "typing_Crypto.AEAD.Invariant.State.prf", + "token_correspondence_FStar.Seq.append", + "token_correspondence_FStar.UInt32.v", + "token_correspondence_Prims.op_LessThan", + "typing_Crypto.AEAD.Invariant.__proj__State__item__prf", "typing_Crypto.AEAD.Invariant.counterblocks", + "typing_Crypto.AEAD.Invariant.minNat", "typing_Crypto.AEAD.Invariant.num_blocks_", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", + "typing_Crypto.Symmetric.PRF.incr", "typing_Crypto.Symmetric.PRF.itable", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.HyperStack.sel", - "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", - "typing_FStar.Seq.index", "typing_FStar.Seq.length", - "typing_FStar.Seq.seq", "typing_FStar.Seq.slice", - "typing_FStar.SeqProperties.snoc", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.sub", - "typing_FStar.UInt32.v", "typing_Flag.prf", "typing_Flag.safeHS", - "typing_Flag.safeId", "typing_Plain.as_buffer", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.HyperStack.sel", "typing_FStar.Seq.create", + "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", + "typing_FStar.Seq.length", "typing_FStar.Seq.seq", + "typing_FStar.Seq.slice", "typing_FStar.SeqProperties.snoc", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.add", + "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", + "typing_FStar.UInt32.sub", "typing_FStar.UInt32.v", + "typing_Flag.prf", "typing_Flag.safeHS", "typing_Flag.safeId", + "typing_Plain.as_buffer", "typing_Plain.slice", "typing_tok_Crypto.AEAD.Invariant.Writer@tok", "unit_inversion" ], 0 @@ -1150,15 +1165,15 @@ 1, 1, [ - "@query", "b2t_def", "bool_inversion", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.AEAD.Encoding.aadmax", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.AEAD.Encoding.aadmax", "equation_Crypto.AEAD.Encoding.alg", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", - "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.maxCtr", "equation_Crypto.Symmetric.PRF.region", "equation_FStar.HyperStack.is_eternal_region", @@ -1170,10 +1185,10 @@ "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_Flag.cipher_alg", "equation_Flag.prf", "equation_Prims.nat", "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "int_inversion", "int_typing", "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", @@ -1182,18 +1197,17 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_2b1eaca42068104bf7df81eab61fb335", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_974fdc5543f58011ac0c7523180c5344", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_d0706cacf28775ed6d73df6c7a971e6a", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", - "typing_Crypto.AEAD.Encoding.alg", "typing_Crypto.Symmetric.AES.v", + "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", - "typing_Flag.cipher_prf", "typing_Flag.safeHS" + "typing_Flag.safeHS" ], 0 ], @@ -1371,15 +1385,15 @@ 1, 1, [ - "@query", "b2t_def", "bool_inversion", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.AEAD.Encoding.aadmax", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.AEAD.Encoding.aadmax", "equation_Crypto.AEAD.Encoding.alg", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", - "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.maxCtr", "equation_Crypto.Symmetric.PRF.region", "equation_FStar.HyperStack.is_eternal_region", @@ -1391,10 +1405,10 @@ "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_Flag.cipher_alg", "equation_Flag.prf", "equation_Prims.nat", "function_token_typing_Crypto.AEAD.Encoding.aadmax", "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "int_inversion", "int_typing", "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", @@ -1403,18 +1417,17 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_2b1eaca42068104bf7df81eab61fb335", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_974fdc5543f58011ac0c7523180c5344", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_d0706cacf28775ed6d73df6c7a971e6a", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", - "typing_Crypto.AEAD.Encoding.alg", "typing_Crypto.Symmetric.AES.v", + "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", - "typing_Flag.cipher_prf", "typing_Flag.safeHS" + "typing_Flag.safeHS" ], 0 ], @@ -1565,8 +1578,8 @@ [ "Crypto.AEAD.Lemmas.refines_empty", 1, - 2, - 2, + 1, + 1, [ "@query", "eq2-interp", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.id", @@ -1586,8 +1599,8 @@ "kinding_Crypto.Symmetric.PRF.entry@tok", "primitive_Prims.op_Equality", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "token_correspondence_FStar.Seq.createEmpty" ], @@ -1664,21 +1677,32 @@ "equation_Crypto.Symmetric.Bytes.mem", "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.region", + "equation_Crypto.Symmetric.Poly1305.MAC.itext", + "equation_Crypto.Symmetric.Poly1305.MAC.text_0", + "equation_Crypto.Symmetric.Poly1305.Spec.elem", + "equation_Crypto.Symmetric.Poly1305.Spec.text", "equation_FStar.HyperStack.is_eternal_region", "equation_FStar.List.Tot.test_sort", + "equation_FStar.SeqProperties.head", "equation_FStar.SeqProperties.tail", "equation_Prims._assert", "equation_Prims.nat", "equation_with_fuel_Crypto.AEAD.Invariant.refines.fuel_instrumented", "equation_with_fuel_Crypto.AEAD.Lemmas.block_lengths.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Lemmas.block_lengths.fuel_instrumented", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.entry", + "fuel_guarded_inversion_Crypto.Symmetric.PRF.entry", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_irrelevance_Crypto.AEAD.Lemmas.block_lengths.fuel_instrumented", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "kinding_Crypto.AEAD.Invariant.entry@tok", + "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", + "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", + "function_token_typing_FStar.List.Tot.test_sort", + "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", + "kinding_Crypto.AEAD.Invariant.entry@tok", "kinding_Crypto.Symmetric.PRF.entry@tok", "l_and-interp", - "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_Addition", + "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", + "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Subtraction", @@ -1686,12 +1710,18 @@ "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", + "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "typing_Crypto.AEAD.Invariant.num_blocks", + "typing_Crypto.AEAD.Lemmas.block_lengths", "typing_FStar.HyperStack.is_eternal_region", - "typing_FStar.Seq.length", "well-founded-ordering-on-nat" + "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", + "typing_FStar.Seq.length", "typing_FStar.Seq.slice", + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -1746,15 +1776,16 @@ "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.head", "equation_FStar.SeqProperties.tail", "equation_FStar.UInt.fits", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_Prims.nat", + "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_Prims.nat", "equation_with_fuel_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_guarded_inversion_Crypto.AEAD.Invariant.entry", "fuel_guarded_inversion_Crypto.Symmetric.PRF.entry", "fuel_guarded_inversion_FStar.HyperStack.mem", - "fuel_irrelevance_Crypto.AEAD.Invariant.refines.fuel_instrumented", "function_token_typing_Crypto.Symmetric.AES.blocklen", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", @@ -1773,6 +1804,7 @@ "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", @@ -1782,12 +1814,12 @@ "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_5ec5b64a8a200c47ed44dad76f0de705", "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "typing_Crypto.AEAD.Invariant.num_blocks", @@ -1830,8 +1862,6 @@ "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.mem", - "equation_Crypto.Symmetric.PRF.id", - "equation_Crypto.Symmetric.PRF.region", "equation_Crypto.Symmetric.PRF.smac", "equation_Crypto.Symmetric.Poly1305.MAC.ideal_log", "equation_Crypto.Symmetric.Poly1305.MAC.ilog", @@ -1845,6 +1875,7 @@ "equation_FStar.HyperStack.live_region", "equation_FStar.HyperStack.modifies_ref", "equation_FStar.HyperStack.ref", "equation_FStar.HyperStack.sel", + "equation_FStar.List.Tot.test_sort", "equation_FStar.Monotonic.RRef.as_hsref", "equation_FStar.Monotonic.RRef.m_contains", "equation_FStar.Monotonic.RRef.m_sel", @@ -1856,8 +1887,9 @@ "equation_FStar.UInt128.t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.t", "equation_Prims.eqtype", - "equation_Prims.l_and", "equation_Prims.nat", "false_interp", + "equation_FStar.UInt8.t", "equation_Prims._assert", + "equation_Prims.eqtype", "equation_Prims.l_and", + "equation_Prims.nat", "false_interp", "fuel_guarded_inversion_Crypto.AEAD.Invariant.entry", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.blocklen", @@ -1867,10 +1899,10 @@ "function_token_typing_FStar.Heap.concat", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", - "function_token_typing_FStar.HyperHeap.rid", "int_inversion", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", "int_typing", "interpretation_Tm_arrow_44faff5d8543c30ad9bf2eeaf1b3abcf", - "kinding_Crypto.Symmetric.PRF.entry@tok", "kinding_FStar.Heap.aref@tok", "l_and-interp", "l_not-interp", "lemma_FStar.TSet.mem_complement", "lemma_FStar.TSet.mem_empty", "lemma_FStar.TSet.mem_intersect", "lemma_Flag.mac1_implies_mac_log", @@ -1895,27 +1927,28 @@ "projection_inverse_Prims.Mktuple2__a", "projection_inverse_Prims.Mktuple2__b", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_077715e5f177c79b6e12915ac4fc7609", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", - "refinement_interpretation_Tm_refine_f3541dc4dd2e5cd1d49dfd99af20aa66", - "refinement_interpretation_Tm_refine_fff1f9c600d11849055700d12b689a33", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_e9be3e34b8974cf7d211692dbf125969", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "token_correspondence_FStar.Heap.concat", "typing_Crypto.AEAD.Invariant.num_blocks", "typing_Crypto.Symmetric.AES.v", "typing_FStar.Heap.contains", "typing_FStar.Heap.domain", "typing_FStar.Heap.restrict", - "typing_FStar.HyperHeap.as_ref", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.MkRef.ref", + "typing_FStar.HyperHeap.as_ref", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__MkRef__item__ref", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.Map.contains", "typing_FStar.Map.sel", - "typing_FStar.Monotonic.RRef.as_hsref", "typing_FStar.Seq.length", + "typing_FStar.Monotonic.RRef.as_hsref", "typing_FStar.TSet.complement", "typing_FStar.TSet.empty", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -2006,8 +2039,8 @@ "kinding_FStar.UInt8.t_@tok", "kinding_Prims.tuple2@tok", "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987" + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6" ], 0 ], @@ -2053,8 +2086,8 @@ "binder_x_b45ebb337d535e9b931447942977447a_5", "binder_x_bbf1021293953dfba038cbf9a2267caa_4", "binder_x_bbf1021293953dfba038cbf9a2267caa_6", "bool_inversion", - "eq2-interp", "equality_tok_Prims.LexTop@tok", - "equation_Crypto.AEAD.Encoding.id", + "constructor_distinct_Prims.Mktuple2", "eq2-interp", + "equality_tok_Prims.LexTop@tok", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.AEAD.Invariant.num_blocks", "equation_Crypto.AEAD.Invariant.refines_one_entry", @@ -2072,17 +2105,19 @@ "equation_Crypto.Symmetric.Poly1305.Spec.elem", "equation_Crypto.Symmetric.Poly1305.Spec.text", "equation_FStar.HyperStack.is_eternal_region", - "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.cons", + "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", + "equation_FStar.SeqProperties.cons", "equation_FStar.SeqProperties.head", "equation_FStar.SeqProperties.snoc", - "equation_FStar.SeqProperties.tail", "equation_FStar.UInt.fits", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", + "equation_FStar.SeqProperties.split", + "equation_FStar.SeqProperties.tail", "equation_FStar.UInt.add", + "equation_FStar.UInt.fits", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.add", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_Flag.mac1", "equation_Prims.nat", + "equation_FStar.UInt8.t", "equation_Prims._assert", + "equation_Prims.l_and", "equation_Prims.nat", "equation_with_fuel_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.refines.fuel_instrumented", "fuel_guarded_inversion_Crypto.AEAD.Invariant.entry", @@ -2094,42 +2129,43 @@ "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", + "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", "kinding_Crypto.AEAD.Invariant.entry@tok", "kinding_Crypto.Symmetric.PRF.entry@tok", "l_and-interp", - "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_create_len", - "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.Seq.lemma_eq_intro", - "lemma_FStar.Seq.lemma_eq_refl", "lemma_FStar.Seq.lemma_index_app1", + "lemma_FStar.Seq.lemma_create_len", "lemma_FStar.Seq.lemma_eq_elim", + "lemma_FStar.Seq.lemma_eq_intro", "lemma_FStar.Seq.lemma_eq_refl", + "lemma_FStar.Seq.lemma_index_app1", "lemma_FStar.Seq.lemma_index_app2", "lemma_FStar.Seq.lemma_index_create", "lemma_FStar.Seq.lemma_index_slice", "lemma_FStar.Seq.lemma_len_append", "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", - "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_Subtraction", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", + "projection_inverse_Prims.Mktuple2__1", + "projection_inverse_Prims.Mktuple2__2", + "projection_inverse_Prims.Mktuple2__a", + "projection_inverse_Prims.Mktuple2__b", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_36f71858b38ea139dd039c1249e1fc69", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_5ec5b64a8a200c47ed44dad76f0de705", "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", "refinement_interpretation_Tm_refine_8718b6ce0adb9c7ae5e1846f05f5d92a", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9579fa2db1a51848d754cc29acdc2303", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "typing_Crypto.AEAD.Invariant.num_blocks", @@ -2137,12 +2173,10 @@ "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.Seq.append", "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", - "typing_FStar.Seq.length", "typing_FStar.Seq.slice", - "typing_FStar.SeqProperties.snoc", "typing_FStar.SeqProperties.tail", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.mac1", - "typing_Flag.mac_int1cma", "typing_Flag.mac_of_id", - "typing_Flag.safeHS", "well-founded-ordering-on-nat" + "typing_FStar.Seq.length", "typing_FStar.SeqProperties.head", + "typing_FStar.SeqProperties.snoc", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v", "typing_Flag.safeHS", "unit_inversion", + "well-founded-ordering-on-nat" ], 0 ], @@ -2179,12 +2213,14 @@ 1, 0, [ - "@query", "b2t_def", "bool_inversion", + "@query", "b2t_def", "bool_inversion", "bool_typing", "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", "equation_Crypto.AEAD.Invariant.safelen", + "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.u32", @@ -2199,38 +2235,36 @@ "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lt", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_Flag.mac1", - "equation_Prims._assert", "equation_Prims.nat", + "equation_FStar.UInt32.v", "equation_Prims._assert", + "equation_Prims.nat", "equation_with_fuel_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", + "fuel_guarded_inversion_Flag.id", + "function_token_typing_Crypto.Symmetric.AES.blocklen", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", - "function_token_typing_FStar.List.Tot.test_sort", - "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", - "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.UInt32.Mk_v", + "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", + "int_typing", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", "refinement_interpretation_Tm_refine_4fb583b6ed3a39b233418432fd30a33b", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "typing_Crypto.AEAD.Invariant.ctr", "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", - "typing_Flag.mac1", "typing_Flag.mac_int1cma", - "typing_Flag.mac_of_id", "typing_Flag.safeHS" + "typing_Flag.safeHS" ], 0 ], @@ -2316,7 +2350,6 @@ "equation_Crypto.AEAD.Encoding.id", "equation_Crypto.AEAD.Invariant.ctr", "equation_Crypto.AEAD.Invariant.id", - "equation_Crypto.AEAD.Invariant.maxplain", "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.keylen", @@ -2355,10 +2388,9 @@ "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Division", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", @@ -2366,24 +2398,25 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_ctr", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", "refinement_interpretation_Tm_refine_813dd2fb2fea1249bfc971377b2a73a0", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_c6f378db5e8d14ed16b970b0ee87669b", + "refinement_interpretation_Tm_refine_c22edbb4bc3be46c2950c2ff4fd7a7ab", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", "refinement_interpretation_Tm_refine_cbe2f0499cf462718acf197d620508c3", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.Cipher.blocklen", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.safeHS", "typing_Flag.safeId" + "typing_FStar.UInt32.__proj__Mk__item__v", "typing_FStar.UInt32.lte", + "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", + "typing_Flag.safeHS", "typing_Flag.safeId" ], 0 ], @@ -2395,12 +2428,12 @@ [ "@query", "b2t_def", "binder_x_0f1e3ab1674b3cc07b69bf3eb488501e_0", "binder_x_25689ef775eb10b0a5e69df3eb11a67b_5", - "binder_x_41ed381374afa63d7232ca2ba4424745_3", - "binder_x_62b1315625d55ab236ad72043b70906e_6", + "binder_x_308adbeaf3713c717a8ebb80ef253d59_2", + "binder_x_36531e82fb08c82e462d9a7e37bee3c7_3", "binder_x_65d9fca123cd2da421029d8df9735be0_8", + "binder_x_70722d7ab01dd1354dc4b63a8b73d0fb_6", "binder_x_969dc8d3c9471a0b164930f39e5fe8fa_1", "binder_x_a10709f583d50a317f2ff974126fd2b5_7", - "binder_x_ae3ff8db64426bd7628dfe396bf30c78_2", "binder_x_ebda2cf8f2dc450dfec27d99774fef2d_4", "bool_inversion", "bool_typing", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", @@ -2435,7 +2468,8 @@ "equation_Crypto.Symmetric.PRF.range", "equation_Crypto.Symmetric.PRF.region", "equation_FStar.HyperStack.is_eternal_region", - "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.cons", + "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", + "equation_FStar.SeqProperties.cons", "equation_FStar.SeqProperties.snoc", "equation_FStar.UInt.add", "equation_FStar.UInt.div", "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", @@ -2449,8 +2483,8 @@ "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt64.n", "equation_FStar.UInt8.t", - "equation_Flag.cipher_of_id", "equation_Plain.as_bytes", - "equation_Plain.plainLen", "equation_Plain.slice", + "equation_Flag.cipher_of_id", "equation_Plain.plainLen", + "equation_Plain.slice", "equation_Prims._assert", "equation_Prims.nat", "equation_with_fuel_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", @@ -2461,20 +2495,21 @@ "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", + "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_FStar.UInt64.n", "int_inversion", "int_typing", "kinding_Crypto.Symmetric.PRF.entry@tok", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_create_len", "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.Seq.lemma_eq_intro", - "lemma_FStar.Seq.lemma_eq_refl", "lemma_FStar.Seq.lemma_index_app1", + "lemma_FStar.Seq.lemma_index_app1", "lemma_FStar.Seq.lemma_index_app2", - "lemma_FStar.Seq.lemma_index_create", "lemma_FStar.Seq.lemma_len_append", "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", - "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_iv", "proj_equation_FStar.UInt32.Mk_v", @@ -2484,54 +2519,50 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_iv", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_0a098a3ff30209fc172904ca1ccc66f8", - "refinement_interpretation_Tm_refine_185b4d478477bb19e7d419d87c835fde", + "refinement_interpretation_Tm_refine_287bd9f5e7e0a6d8d926d7dddf934527", "refinement_interpretation_Tm_refine_34552f8dc046e3b039072697e7a363f8", + "refinement_interpretation_Tm_refine_3537e32e88b2ecec66227bd0c8a69b61", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", "refinement_interpretation_Tm_refine_4f9f942a7e3bcdf469ffd9f6440f72c3", + "refinement_interpretation_Tm_refine_517edd6681fd1e8aba97c31c41dc4514", + "refinement_interpretation_Tm_refine_547862b57672d7b38b52111ec7584d01", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", + "refinement_interpretation_Tm_refine_6a5867b104f74ce2c827af3a70b1d25b", "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9579fa2db1a51848d754cc29acdc2303", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_9d836f17260390394ee04e04c2340c0e", - "refinement_interpretation_Tm_refine_a93f84e364f30647151ce528fc3c7b9a", "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdd87f43ab7acc9af6959bbd18e486d3", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", "refinement_interpretation_Tm_refine_e8a3b061c144fe07c532f73daf3668ea", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", - "token_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", - "token_correspondence_Prims.op_LessThan", "typing_Crypto.AEAD.Invariant.counterblocks", "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.Cipher.blocklen", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.Mkdomain.iv", - "typing_Crypto.Symmetric.PRF.blocklen", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__iv", + "typing_Crypto.Symmetric.PRF.incr", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", - "typing_FStar.Mul.op_Star", "typing_FStar.Seq.append", - "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", - "typing_FStar.Seq.index", "typing_FStar.Seq.length", - "typing_FStar.Seq.slice", "typing_FStar.SeqProperties.cons", - "typing_FStar.SeqProperties.snoc", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.add", "typing_FStar.UInt32.lt", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.sub", - "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", - "typing_Flag.cipher_of_id", "typing_Flag.safeHS", - "typing_Flag.safeId", "typing_Plain.as_bytes", "typing_Plain.slice", - "well-founded-ordering-on-nat" + "typing_FStar.Mul.op_Star", "typing_FStar.Seq.create", + "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.slice", + "typing_FStar.SeqProperties.cons", "typing_FStar.SeqProperties.snoc", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.add", + "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", + "typing_FStar.UInt32.sub", "typing_FStar.UInt32.uint_to_t", + "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", + "typing_Flag.safeHS", "typing_Flag.safeId", "typing_Plain.slice", + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -2655,35 +2686,32 @@ "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", - "function_token_typing_FStar.UInt32.v", "int_inversion", - "int_typing", - "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", - "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", - "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "int_inversion", "int_typing", "kinding_FStar.UInt8.t_@tok", + "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Seq.lemma_len_slice", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_533f0b509f5ad67b0c7927877622f213", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", - "refinement_interpretation_Tm_refine_f60e3fb437ea5def1ac64fb93fc5646c", - "token_correspondence_FStar.UInt32.v", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", - "typing_Flag.safeHS" + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.uint_to_t", + "typing_FStar.UInt32.v", "typing_Flag.safeHS" ], 0 ], @@ -2697,12 +2725,11 @@ "binder_x_067229a5d1b0064630d2c0f8961363af_7", "binder_x_0f1e3ab1674b3cc07b69bf3eb488501e_0", "binder_x_2a6d7f92917330a9aad78e30231f1666_6", + "binder_x_308adbeaf3713c717a8ebb80ef253d59_2", "binder_x_969dc8d3c9471a0b164930f39e5fe8fa_1", + "binder_x_9dd58c31ca382ac713f8bb1a48d97a74_5", "binder_x_a51c1c074dfd6f78d4c51867b62b79be_3", - "binder_x_ae3ff8db64426bd7628dfe396bf30c78_2", - "binder_x_c3565b707d096a8aad85630bf8e93d2a_5", "binder_x_e22ba7a032a73f6d0678d3d186686631_4", "bool_inversion", - "bool_typing", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", "data_typing_intro_Crypto.Symmetric.PRF.Entry@tok", @@ -2772,7 +2799,7 @@ "kinding_Crypto.Symmetric.PRF.entry@tok", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_eq_elim", - "lemma_FStar.Seq.lemma_eq_intro", + "lemma_FStar.Seq.lemma_eq_intro", "lemma_FStar.Seq.lemma_eq_refl", "lemma_FStar.Seq.lemma_index_slice", "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.safeId_implies_mac1", "primitive_Prims.op_Addition", @@ -2787,51 +2814,49 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_ctr", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_113004b17ad5282f2eb643c93c9984fb", + "refinement_interpretation_Tm_refine_1e89587c52e13e243444908ae3d53813", + "refinement_interpretation_Tm_refine_23d7348dee69afe5b479164b38af7ed1", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", + "refinement_interpretation_Tm_refine_3c3545951747d746b43fed099bba380e", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_5ec5b64a8a200c47ed44dad76f0de705", "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", + "refinement_interpretation_Tm_refine_6a5867b104f74ce2c827af3a70b1d25b", "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_849bff6b3631dcadc8e2ecbaad49b4de", - "refinement_interpretation_Tm_refine_8a1159bf9c4c5089efa49c801fbfed85", - "refinement_interpretation_Tm_refine_8ef78f8806e76b60fba0742b62dfc18b", - "refinement_interpretation_Tm_refine_962f51c795313d3a94056f2ed71d228a", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_9d836f17260390394ee04e04c2340c0e", - "refinement_interpretation_Tm_refine_a93f84e364f30647151ce528fc3c7b9a", "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", - "refinement_interpretation_Tm_refine_b67dccbcac4c4c703934436aa43a6e9d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", + "refinement_interpretation_Tm_refine_e548fceadf58a12844cda16b85e9a32a", + "refinement_interpretation_Tm_refine_f2e30238a053de171a32d74976a86b60", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", "token_correspondence_FStar.UInt32.v", "typing_Crypto.AEAD.Invariant.counterblocks", - "typing_Crypto.AEAD.Invariant.safelen", "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.Cipher.blocklen", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_Crypto.Symmetric.PRF.maxCtr", "typing_FStar.HyperStack.is_eternal_region", - "typing_FStar.Mul.op_Star", "typing_FStar.Seq.createEmpty", - "typing_FStar.Seq.length", "typing_FStar.Seq.slice", - "typing_FStar.SeqProperties.cons", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", - "typing_FStar.UInt32.sub", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", - "typing_Flag.mac1", "typing_Flag.mac_int1cma", - "typing_Flag.mac_of_id", "typing_Flag.safeId", - "typing_Plain.as_bytes", "typing_Plain.slice", + "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.length", + "typing_FStar.Seq.slice", "typing_FStar.SeqProperties.cons", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.lt", + "typing_FStar.UInt32.lte", "typing_FStar.UInt32.sub", + "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", + "typing_Flag.cipher_of_id", "typing_Flag.mac1", + "typing_Flag.mac_int1cma", "typing_Flag.mac_of_id", + "typing_Flag.safeHS", "typing_Flag.safeId", "typing_Plain.as_bytes", + "typing_Plain.slice", "unit_inversion", "well-founded-ordering-on-nat" ], 0 @@ -2859,10 +2884,10 @@ 1, 0, [ - "@query", "binder_x_c3565b707d096a8aad85630bf8e93d2a_5", + "@query", "binder_x_9dd58c31ca382ac713f8bb1a48d97a74_5", "equation_Prims.nat", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_8ef78f8806e76b60fba0742b62dfc18b" + "refinement_interpretation_Tm_refine_23d7348dee69afe5b479164b38af7ed1" ], 0 ], @@ -2872,10 +2897,10 @@ 1, 0, [ - "@query", "binder_x_c3565b707d096a8aad85630bf8e93d2a_5", + "@query", "binder_x_9dd58c31ca382ac713f8bb1a48d97a74_5", "equation_Prims.nat", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_8ef78f8806e76b60fba0742b62dfc18b" + "refinement_interpretation_Tm_refine_23d7348dee69afe5b479164b38af7ed1" ], 0 ], @@ -2997,7 +3022,7 @@ [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 15, - 0, + 1, 0, [ "@query", "equation_Crypto.AEAD.Lemmas.u", @@ -3011,8 +3036,8 @@ "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", "pretyping_ae567c2fb75be05905677af440075565", @@ -3023,11 +3048,12 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], @@ -3064,7 +3090,8 @@ "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], @@ -3119,7 +3146,7 @@ [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 23, - 0, + 1, 0, [ "@query", "b2t_def", "bool_inversion", "bool_typing", @@ -3153,21 +3180,21 @@ "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.div", - "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", - "equation_FStar.UInt.lt", "equation_FStar.UInt.lte", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt32.div", "equation_FStar.UInt32.gt", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", + "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", + "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.sub", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lt", "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt64.n", "equation_FStar.UInt8.byte", - "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", - "equation_Plain.as_buffer", "equation_Plain.plainLen", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.UInt64.n", "equation_FStar.UInt8.t", + "equation_Flag.cipher_of_id", "equation_Plain.as_buffer", + "equation_Plain.plainLen", "equation_Prims.nat", + "fuel_guarded_inversion_Crypto.Symmetric.PRF.state", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", @@ -3180,10 +3207,10 @@ "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.lemma_sub_spec", "lemma_FStar.Int.pow2_values", "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_Division", - "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.Buffer.MkBuffer_length", @@ -3195,42 +3222,45 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_1b6735750293b0f2d82400272c83fe68", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", "refinement_interpretation_Tm_refine_353b4b685257c56fbfc7dc87f288226a", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7874c81428902f5ef0683ead2eab5830", "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_aea942bbe9896a2bb0cdb2c9e0ebc1e4", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_c1f3b0238a2c4e65d7abaebdce5f9444", - "refinement_interpretation_Tm_refine_c6f378db5e8d14ed16b970b0ee87669b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", + "refinement_interpretation_Tm_refine_c22edbb4bc3be46c2950c2ff4fd7a7ab", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", + "token_correspondence_Prims.op_LessThan", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", "typing_Crypto.Symmetric.PRF.blocklen", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.as_seq", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.safeHS", "typing_Flag.safeId", - "typing_Plain.as_buffer" + "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", + "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", + "typing_Flag.safeHS", "typing_Flag.safeId", "typing_Plain.as_buffer" ], 0 ], [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 24, - 0, + 1, 0, [ "@query", "assumption_FStar.HyperHeap.HasEq_rid", @@ -3238,12 +3268,9 @@ "bool_typing", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", - "constructor_distinct_Prims.None", "constructor_distinct_Prims.Some", - "constructor_distinct_Prims.option", - "constructor_distinct_Prims.unit", "data_typing_intro_Crypto.Symmetric.PRF.Entry@tok", "data_typing_intro_Crypto.Symmetric.PRF.Mkdomain@tok", - "data_typing_intro_Crypto.Symmetric.PRF.OTP@tok", "eq2-interp", + "data_typing_intro_Crypto.Symmetric.PRF.OTP@tok", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", "equation_Crypto.AEAD.Encoding.id", @@ -3254,6 +3281,7 @@ "equation_Crypto.AEAD.Invariant.region", "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.AEAD.Lemmas.u", + "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", @@ -3269,15 +3297,11 @@ "equation_Crypto.Symmetric.Cipher.blocklen", "equation_Crypto.Symmetric.PRF.blocklen", "equation_Crypto.Symmetric.PRF.ctrT", - "equation_Crypto.Symmetric.PRF.extends", - "equation_Crypto.Symmetric.PRF.find", "equation_Crypto.Symmetric.PRF.id", - "equation_Crypto.Symmetric.PRF.itable", "equation_Crypto.Symmetric.PRF.maxCtr", "equation_Crypto.Symmetric.PRF.modifies_x_buffer_1", "equation_Crypto.Symmetric.PRF.range", "equation_Crypto.Symmetric.PRF.region", - "equation_Crypto.Symmetric.PRF.table_t", "equation_Crypto.Symmetric.Poly1305.MAC.itext", "equation_Crypto.Symmetric.Poly1305.MAC.text_0", "equation_Crypto.Symmetric.Poly1305.Spec.elem", @@ -3295,24 +3319,24 @@ "equation_FStar.HyperStack.frameOf", "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.live_region", "equation_FStar.HyperStack.modifies", - "equation_FStar.HyperStack.ref", "equation_FStar.HyperStack.sel", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.add", - "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", + "equation_FStar.HyperStack.sel", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.add", "equation_FStar.UInt.fits", + "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.add", - "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lte", - "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", + "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lt", + "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", "equation_Flag.prf", "equation_Plain.as_buffer", "equation_Plain.as_bytes", "equation_Plain.live", "equation_Plain.plainLen", "equation_Plain.sel_plain", "equation_Plain.slice", - "equation_Prims._assert", "equation_Prims.eqtype", - "equation_Prims.nat", "equation_Prims.pos", + "equation_Prims.eqtype", "equation_Prims.nat", + "equation_with_fuel_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_Crypto.Symmetric.PRF.state", @@ -3320,6 +3344,8 @@ "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", + "fuel_irrelevance_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", + "function_token_typing_Crypto.Symmetric.AES.blocklen", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", @@ -3328,14 +3354,9 @@ "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", - "function_token_typing_FStar.SeqProperties.snoc", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", - "interpretation_Tm_abs_826608555216c536a7cbe67753c8fa74", - "interpretation_Tm_arrow_60dded2fac76d116672c2a6bb6cdd1a7", - "interpretation_Tm_arrow_9cb3c953faf527c316d427b2ce8bd81b", - "interpretation_Tm_arrow_ed7ad77392d2ee206477ed8d4effcdfa", "kinding_Crypto.Symmetric.PRF.entry@tok", - "kinding_FStar.UInt8.t_@tok", "l_and-interp", + "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_sub", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.lemma_sub_spec", @@ -3343,21 +3364,16 @@ "lemma_FStar.Map.lemma_SelConcat1", "lemma_FStar.Map.lemma_SelRestrict", "lemma_FStar.Map.lemma_equal_elim", "lemma_FStar.Seq.lemma_eq_elim", - "lemma_FStar.Seq.lemma_len_slice", "lemma_FStar.Set.mem_complement", - "lemma_FStar.Set.mem_singleton", "lemma_FStar.Set.mem_union", - "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.mac1_implies_prf", - "lemma_Flag.safeId_implies_mac1", - "pretyping_533d8a9fddfb9ab2d24280a2b80ade9f", + "lemma_FStar.Seq.lemma_eq_refl", "lemma_FStar.Seq.lemma_len_slice", + "lemma_FStar.Set.mem_complement", "lemma_FStar.Set.mem_singleton", + "lemma_FStar.Set.mem_union", "lemma_Flag.mac1_implies_mac_log", + "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", "pretyping_6c86c071b92797cdf01eb016249a9465", - "pretyping_779086306c29597e3dd1127d16405da1", - "pretyping_f537159ed795b314b4e58c260361ae86", - "pretyping_f8666440faa91836cc5a13998af863fc", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Negation", "primitive_Prims.op_Subtraction", - "proj_equation_Crypto.Symmetric.PRF.Entry_x", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_iv", "proj_equation_Crypto.Symmetric.PRF.State_rgn", @@ -3374,16 +3390,12 @@ "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_iv", "projection_inverse_FStar.Buffer.MkBuffer_content", "projection_inverse_FStar.Buffer.MkBuffer_idx", + "projection_inverse_FStar.Buffer.MkBuffer_length", "projection_inverse_FStar.UInt32.Mk_v", - "projection_inverse_Prims.None_a", "projection_inverse_Prims.Some_a", - "projection_inverse_Prims.Some_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", - "refinement_interpretation_Tm_refine_124f9a17930ed5399c6ce9b2a0d8ee4a", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_1b6735750293b0f2d82400272c83fe68", - "refinement_interpretation_Tm_refine_27eb738955e795e5dd1cab5fe18de9a0", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", "refinement_interpretation_Tm_refine_353b4b685257c56fbfc7dc87f288226a", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", @@ -3391,276 +3403,104 @@ "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", - "refinement_interpretation_Tm_refine_6dcb21a272243833262302041761c187", "refinement_interpretation_Tm_refine_7874c81428902f5ef0683ead2eab5830", "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", + "refinement_interpretation_Tm_refine_962f51c795313d3a94056f2ed71d228a", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_9d836f17260390394ee04e04c2340c0e", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_a917a802cdb0c45fe1a8176d288f4ee0", "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_c6f378db5e8d14ed16b970b0ee87669b", + "refinement_interpretation_Tm_refine_c1f3b0238a2c4e65d7abaebdce5f9444", + "refinement_interpretation_Tm_refine_c22edbb4bc3be46c2950c2ff4fd7a7ab", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", - "refinement_interpretation_Tm_refine_ddbb7b6e3ac4fe079caca5e0be6b3dbd", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", + "refinement_interpretation_Tm_refine_eb8f0a0ac9d8793518e02704d205443b", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", "token_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", - "token_correspondence_FStar.SeqProperties.snoc", + "token_correspondence_Prims.op_LessThan", "typing_Crypto.AEAD.Invariant.counterblocks", - "typing_Crypto.AEAD.Invariant.maxplain", + "typing_Crypto.AEAD.Invariant.safelen", "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.Bytes.sel_bytes", - "typing_Crypto.Symmetric.PRF.Entry.x", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.Mkdomain.iv", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", - "typing_Crypto.Symmetric.PRF.State.rgn", - "typing_Crypto.Symmetric.PRF.State.table", + "typing_Crypto.Symmetric.Cipher.blocklen", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__iv", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", + "typing_Crypto.Symmetric.PRF.__proj__State__item__rgn", "typing_Crypto.Symmetric.PRF.blocklen", - "typing_Crypto.Symmetric.PRF.find", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.frameOf", - "typing_FStar.Buffer.sub", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.concat", - "typing_FStar.Map.contains", "typing_FStar.Map.restrict", - "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", - "typing_FStar.Seq.length", "typing_FStar.Seq.seq", - "typing_FStar.SeqProperties.seq_find", - "typing_FStar.SeqProperties.snoc", "typing_FStar.Set.complement", - "typing_FStar.Set.mem", "typing_FStar.Set.singleton", - "typing_FStar.Set.union", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.safeHS", "typing_Flag.safeId", - "typing_Plain.as_buffer", "typing_Plain.slice", - "typing_Tm_abs_826608555216c536a7cbe67753c8fa74", "unit_typing" + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.concat", "typing_FStar.Map.contains", + "typing_FStar.Map.restrict", "typing_FStar.Seq.createEmpty", + "typing_FStar.Seq.length", "typing_FStar.SeqProperties.snoc", + "typing_FStar.Set.complement", "typing_FStar.Set.mem", + "typing_FStar.Set.singleton", "typing_FStar.Set.union", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.lt", + "typing_FStar.UInt32.lte", "typing_FStar.UInt32.sub", + "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", + "typing_Flag.cipher_of_id", "typing_Flag.safeHS", + "typing_Flag.safeId", "typing_Plain.as_buffer", "typing_Plain.slice" ], 0 ], [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 25, - 0, + 1, 0, [ - "@query", "assumption_FStar.HyperHeap.HasEq_rid", - "assumption_FStar.Seq.Extensionality", "b2t_def", "bool_inversion", - "bool_typing", - "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", - "constructor_distinct_Flag.CHACHA20_POLY1305", - "constructor_distinct_Tm_unit", - "data_typing_intro_Crypto.Symmetric.PRF.Entry@tok", - "data_typing_intro_Crypto.Symmetric.PRF.Mkdomain@tok", - "data_typing_intro_Crypto.Symmetric.PRF.OTP@tok", - "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", - "equality_tok_Flag.CHACHA20_POLY1305@tok", - "equation_Crypto.AEAD.Encoding.id", - "equation_Crypto.AEAD.Invariant.ctr", - "equation_Crypto.AEAD.Invariant.id", - "equation_Crypto.AEAD.Invariant.maxplain", - "equation_Crypto.AEAD.Invariant.minNat", - "equation_Crypto.AEAD.Invariant.region", - "equation_Crypto.AEAD.Invariant.safelen", - "equation_Crypto.AEAD.Lemmas.u", - "equation_Crypto.Symmetric.AES.blocklen", + "@query", "equation_Crypto.AEAD.Lemmas.u", "equation_Crypto.Symmetric.AES.keylen", - "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Bytes.buffer", - "equation_Crypto.Symmetric.Bytes.bytes", "equation_Crypto.Symmetric.Bytes.lbuffer", - "equation_Crypto.Symmetric.Bytes.lbytes", - "equation_Crypto.Symmetric.Bytes.mem", - "equation_Crypto.Symmetric.Bytes.sel_bytes", - "equation_Crypto.Symmetric.Bytes.u32", - "equation_Crypto.Symmetric.Chacha20.blocklen", - "equation_Crypto.Symmetric.Cipher.blocklen", - "equation_Crypto.Symmetric.PRF.blocklen", - "equation_Crypto.Symmetric.PRF.ctrT", - "equation_Crypto.Symmetric.PRF.id", - "equation_Crypto.Symmetric.PRF.maxCtr", - "equation_Crypto.Symmetric.PRF.modifies_x_buffer_1", - "equation_Crypto.Symmetric.PRF.range", - "equation_Crypto.Symmetric.PRF.region", - "equation_Crypto.Symmetric.Poly1305.MAC.itext", - "equation_Crypto.Symmetric.Poly1305.MAC.text_0", - "equation_Crypto.Symmetric.Poly1305.Spec.elem", - "equation_Crypto.Symmetric.Poly1305.Spec.text", - "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", - "equation_FStar.Buffer.disjoint", "equation_FStar.Buffer.equal", - "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.modifies_buf_1", - "equation_FStar.Buffer.sel", "equation_FStar.Buffer.sub", - "equation_FStar.HyperHeap.modifies_just", - "equation_FStar.HyperHeap.sel", "equation_FStar.HyperHeap.t", - "equation_FStar.HyperStack.contains", - "equation_FStar.HyperStack.frameOf", "equation_FStar.HyperStack.hh", - "equation_FStar.HyperStack.live_region", - "equation_FStar.HyperStack.modifies", - "equation_FStar.HyperStack.sel", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.add", "equation_FStar.UInt.div", - "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", - "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", - "equation_FStar.UInt.size", "equation_FStar.UInt.sub", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.add", - "equation_FStar.UInt32.div", "equation_FStar.UInt32.gt", - "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", - "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", - "equation_Flag.prf", "equation_Plain.as_buffer", - "equation_Plain.as_bytes", "equation_Plain.live", - "equation_Plain.plainLen", "equation_Plain.sel_plain", - "equation_Plain.slice", "equation_Prims.eqtype", - "equation_Prims.nat", - "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", - "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", - "fuel_guarded_inversion_Crypto.Symmetric.PRF.state", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.length", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.mul", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.t", "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", - "fuel_guarded_inversion_FStar.HyperStack.mem", - "fuel_guarded_inversion_FStar.HyperStack.reference", - "fuel_guarded_inversion_FStar.UInt32.t_", - "function_token_typing_Crypto.Symmetric.AES.blocklen", - "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", - "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", - "function_token_typing_FStar.Heap.emp", - "function_token_typing_FStar.Heap.heap", - "function_token_typing_FStar.HyperHeap.rid", - "function_token_typing_FStar.SeqProperties.snoc", - "function_token_typing_FStar.UInt32.v", - "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", - "interpretation_Tm_arrow_15569832cb7b48ce3fe999c98911dd3f", - "interpretation_Tm_arrow_ed7ad77392d2ee206477ed8d4effcdfa", - "kinding_Crypto.Symmetric.PRF.entry@tok", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", - "lemma_FStar.Buffer.lemma_disjoint_sub", - "lemma_FStar.Buffer.lemma_disjoint_symm", - "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.lemma_sub_spec", - "lemma_FStar.Int.pow2_values", "lemma_FStar.Map.lemma_InDomRestrict", - "lemma_FStar.Map.lemma_SelConcat1", - "lemma_FStar.Map.lemma_SelRestrict", - "lemma_FStar.Map.lemma_equal_elim", "lemma_FStar.Seq.lemma_eq_elim", - "lemma_FStar.Seq.lemma_eq_intro", "lemma_FStar.Seq.lemma_len_slice", - "lemma_FStar.Set.mem_complement", "lemma_FStar.Set.mem_singleton", - "lemma_FStar.Set.mem_union", "lemma_Flag.mac1_implies_mac_log", - "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", - "pretyping_6c86c071b92797cdf01eb016249a9465", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Negation", "primitive_Prims.op_Subtraction", - "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", - "proj_equation_Crypto.Symmetric.PRF.Mkdomain_iv", - "proj_equation_Crypto.Symmetric.PRF.State_rgn", - "proj_equation_FStar.Buffer.MkBuffer_content", - "proj_equation_FStar.Buffer.MkBuffer_idx", + "pretyping_ae567c2fb75be05905677af440075565", + "primitive_Prims.op_Multiply", "proj_equation_FStar.Buffer.MkBuffer_length", - "proj_equation_FStar.HyperStack.HS_h", - "proj_equation_FStar.HyperStack.MkRef_id", - "proj_equation_FStar.HyperStack.MkRef_ref", "proj_equation_FStar.UInt32.Mk_v", - "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", - "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_ctr", - "projection_inverse_Crypto.Symmetric.PRF.Mkdomain_iv", - "projection_inverse_FStar.Buffer.MkBuffer_content", - "projection_inverse_FStar.Buffer.MkBuffer_idx", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_1b6735750293b0f2d82400272c83fe68", - "refinement_interpretation_Tm_refine_27eb738955e795e5dd1cab5fe18de9a0", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", - "refinement_interpretation_Tm_refine_353b4b685257c56fbfc7dc87f288226a", - "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", - "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", - "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", - "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", - "refinement_interpretation_Tm_refine_57460688c107ae4c5fb29a298ce8fe4b", - "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_60a6a65e19fd6fdaf090cf47e332ef1e", - "refinement_interpretation_Tm_refine_6d225ce07de2247b5d87ae4e35eb4e9c", - "refinement_interpretation_Tm_refine_6dcb21a272243833262302041761c187", - "refinement_interpretation_Tm_refine_7874c81428902f5ef0683ead2eab5830", - "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", - "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", - "refinement_interpretation_Tm_refine_a917a802cdb0c45fe1a8176d288f4ee0", - "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", - "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_c6f378db5e8d14ed16b970b0ee87669b", - "refinement_interpretation_Tm_refine_c80f93641670351ef037bee53d1c4edc", - "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", - "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", - "refinement_interpretation_Tm_refine_e3bd6349ceee702d3a96ca0a3f47d654", - "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", - "refinement_kinding_Tm_refine_c80f93641670351ef037bee53d1c4edc", - "token_correspondence_FStar.SeqProperties.snoc", - "token_correspondence_FStar.UInt32.v", - "typing_Crypto.AEAD.Invariant.counterblocks", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.Bytes.sel_bytes", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.Mkdomain.iv", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", - "typing_Crypto.Symmetric.PRF.State.rgn", - "typing_Crypto.Symmetric.PRF.blocklen", - "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", - "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.frameOf", - "typing_FStar.Buffer.idx", "typing_FStar.Buffer.length", - "typing_FStar.Buffer.sub", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.concat", - "typing_FStar.Map.contains", "typing_FStar.Map.restrict", - "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.length", - "typing_FStar.SeqProperties.snoc", "typing_FStar.Set.complement", - "typing_FStar.Set.mem", "typing_FStar.Set.singleton", - "typing_FStar.Set.union", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.safeHS", "typing_Flag.safeId", - "typing_Plain.as_buffer", "typing_Plain.slice" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 26, - 0, + 1, 0, [ "@query", "equation_Crypto.AEAD.Lemmas.u", @@ -3674,8 +3514,8 @@ "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", "pretyping_ae567c2fb75be05905677af440075565", @@ -3686,18 +3526,19 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], [ "Crypto.AEAD.Lemmas.frame_counterblocks_snoc", 27, - 0, + 1, 0, [ "@query", "equation_Crypto.AEAD.Lemmas.u", @@ -3711,8 +3552,8 @@ "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", "pretyping_ae567c2fb75be05905677af440075565", @@ -3723,11 +3564,12 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], @@ -3764,7 +3606,8 @@ "refinement_interpretation_Tm_refine_b411c17f6726a298e8eb613f8b778904", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], @@ -4093,11 +3936,10 @@ [ "Crypto.AEAD.Lemmas.extending_counter_blocks", 27, - 0, + 1, 0, [ - "@query", "assumption_Prims.HasEq_int", - "equation_Crypto.AEAD.Lemmas.u", + "@query", "equation_Crypto.AEAD.Lemmas.u", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.v", @@ -4109,8 +3951,7 @@ "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", - "function_token_typing_Crypto.Symmetric.AES.keylen", - "haseqTm_refine_ba523126f67e00e7cd55f0b92f16681d", "int_inversion", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Multiply", @@ -4120,12 +3961,12 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_353b4b685257c56fbfc7dc87f288226a", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v", - "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v", "typing_FStar.UInt32.v" ], 0 ], @@ -4163,8 +4004,8 @@ "refinement_interpretation_Tm_refine_aab2fb33320be4b0f3704537fdecd512", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v", - "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v", "typing_FStar.UInt32.v" ], 0 ], @@ -4294,13 +4135,13 @@ "refinement_interpretation_Tm_refine_e21fdb4ce98402f09e35198e76d30fd0", "typing_Crypto.Symmetric.AES.v", "typing_Crypto.Symmetric.Cipher.blocklen", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.State.table", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__State__item__table", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.length", "typing_FStar.UInt.fits", "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", @@ -4345,13 +4186,12 @@ [ "Crypto.AEAD.Lemmas.extending_counter_blocks", 37, - 0, + 1, 0, [ "@query", "b2t_def", "bool_inversion", "bool_typing", "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", - "disc_equation_Prims.Some", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", "equation_Crypto.AEAD.Encoding.id", @@ -4369,33 +4209,33 @@ "equation_Crypto.Symmetric.Bytes.buffer", "equation_Crypto.Symmetric.Bytes.lbuffer", "equation_Crypto.Symmetric.Bytes.mem", - "equation_Crypto.Symmetric.Bytes.u32", "equation_Crypto.Symmetric.Chacha20.blocklen", "equation_Crypto.Symmetric.Cipher.blocklen", "equation_Crypto.Symmetric.PRF.blocklen", - "equation_Crypto.Symmetric.PRF.ctrT", "equation_Crypto.Symmetric.PRF.id", "equation_Crypto.Symmetric.PRF.itable", "equation_Crypto.Symmetric.PRF.maxCtr", "equation_Crypto.Symmetric.PRF.modifies_x_buffer_1", + "equation_Crypto.Symmetric.PRF.table_t", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", "equation_FStar.Buffer.sub", "equation_FStar.HyperStack.ref", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", - "equation_FStar.UInt.lt", "equation_FStar.UInt.lte", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.sub", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt.div", "equation_FStar.UInt.fits", + "equation_FStar.UInt.gt", "equation_FStar.UInt.lt", + "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.sub", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.div", "equation_FStar.UInt32.gt", "equation_FStar.UInt32.lt", "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt32.v", "equation_FStar.UInt64.n", "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", - "equation_Plain.as_buffer", "equation_Plain.live", - "equation_Plain.plainLen", "equation_Plain.sub", - "equation_Prims.l_False", "equation_Prims.nat", + "equation_Flag.prf", "equation_Plain.as_buffer", + "equation_Plain.live", "equation_Plain.plainLen", + "equation_Plain.sub", "equation_Prims.l_False", "equation_Prims.nat", "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_Crypto.Symmetric.PRF.state", "fuel_guarded_inversion_FStar.Buffer._buffer", @@ -4406,15 +4246,16 @@ "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", - "int_inversion", "int_typing", - "kinding_Crypto.Symmetric.PRF.otp@tok", "kinding_FStar.UInt8.t_@tok", - "lemma_FStar.Buffer.lemma_size", "lemma_Flag.mac1_implies_prf", + "function_token_typing_FStar.UInt64.n", "int_inversion", + "int_typing", "kinding_Crypto.Symmetric.PRF.otp@tok", + "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_size", + "lemma_FStar.Int.pow2_values", "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", "lemma_Prims.invertOption", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", "primitive_Prims.op_LessThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "primitive_Prims.op_BarBar", "primitive_Prims.op_Division", + "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_Crypto.Symmetric.PRF.Mkdomain_ctr", "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.Buffer.MkBuffer_length", @@ -4426,49 +4267,46 @@ "projection_inverse_FStar.Buffer.MkBuffer_content", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0991f788dbb220993dffda8c3c28b9ce", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_1b6735750293b0f2d82400272c83fe68", "refinement_interpretation_Tm_refine_27eb738955e795e5dd1cab5fe18de9a0", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", + "refinement_interpretation_Tm_refine_2e09186152b6bcec91dd27c9dcd50774", "refinement_interpretation_Tm_refine_353b4b685257c56fbfc7dc87f288226a", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", + "refinement_interpretation_Tm_refine_565a37ff3f9acc0c7ae83bc3e848ab17", "refinement_interpretation_Tm_refine_6dcb21a272243833262302041761c187", "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", - "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", - "refinement_interpretation_Tm_refine_a57b551dc0f312d391aa44f548d97477", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_aea942bbe9896a2bb0cdb2c9e0ebc1e4", - "refinement_interpretation_Tm_refine_b15dc250df6ac242c7d2a33a77c3908d", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", - "refinement_interpretation_Tm_refine_c8c150a3a5ebfb73654ea86e2ea7fe35", - "refinement_interpretation_Tm_refine_caa040d2e057ffef1aed61ff52942219", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", - "refinement_interpretation_Tm_refine_deb68a2ba9316e7f1502cc670399a37c", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", + "refinement_interpretation_Tm_refine_ddbb7b6e3ac4fe079caca5e0be6b3dbd", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", + "typing_Crypto.Symmetric.PRF.__proj__State__item__table", "typing_Crypto.Symmetric.PRF.blocklen", - "typing_Crypto.Symmetric.PRF.itable", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", - "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.sub", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.Buffer.sub", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.lt", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", - "typing_Flag.safeHS", "typing_Plain.as_buffer", - "typing_Prims.is_None" + "typing_Flag.prf", "typing_Flag.safeHS", "typing_Plain.as_buffer", + "typing_Prims.is_None", "typing_Prims.is_Some" ], 0 ], [ "Crypto.AEAD.Lemmas.extending_counter_blocks", 38, - 0, + 1, 0, [ "@query", "assumption_FStar.Seq.Extensionality", "b2t_def", @@ -4476,8 +4314,10 @@ "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", "constructor_distinct_Flag.CHACHA20_POLY1305", "constructor_distinct_Prims.None", "constructor_distinct_Prims.Some", - "constructor_distinct_Tm_unit", + "constructor_distinct_Prims.option", + "constructor_distinct_Prims.unit", "constructor_distinct_Tm_unit", "data_typing_intro_Crypto.Symmetric.PRF.Mkdomain@tok", + "disc_equation_Prims.None", "disc_equation_Prims.Some", "eq2-interp", "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", "equality_tok_Flag.CHACHA20_POLY1305@tok", "equation_Crypto.AEAD.Encoding.id", @@ -4522,11 +4362,12 @@ "equation_Crypto.Symmetric.Poly1305.Spec.text", "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", - "equation_FStar.Buffer.idx", "equation_FStar.Buffer.length", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.sub", - "equation_FStar.HyperStack.ref", "equation_FStar.HyperStack.sel", - "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", - "equation_FStar.SeqProperties.last", + "equation_FStar.Buffer.idx", "equation_FStar.Buffer.includes", + "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.sub", "equation_FStar.HyperStack.ref", + "equation_FStar.HyperStack.sel", "equation_FStar.List.Tot.test_sort", + "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.last", + "equation_FStar.SeqProperties.seq_find", "equation_FStar.SeqProperties.snoc", "equation_FStar.UInt.add", "equation_FStar.UInt.fits", "equation_FStar.UInt.gt", "equation_FStar.UInt.gte", "equation_FStar.UInt.lte", @@ -4538,13 +4379,15 @@ "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Flag.cipher_of_id", "equation_Flag.prf", - "equation_Plain.as_buffer", "equation_Plain.as_bytes", - "equation_Plain.live", "equation_Plain.plainLen", - "equation_Plain.sel_plain", "equation_Plain.slice", - "equation_Plain.sub", "equation_Prims._assert", "equation_Prims.nat", + "equation_FStar.UInt8.t", "equation_Flag.cipher_of_id", + "equation_Flag.prf", "equation_Plain.as_buffer", + "equation_Plain.as_bytes", "equation_Plain.live", + "equation_Plain.plainLen", "equation_Plain.sel_plain", + "equation_Plain.slice", "equation_Plain.sub", + "equation_Prims._assert", "equation_Prims.nat", + "equation_with_fuel_FStar.SeqProperties.seq_find_aux.fuel_instrumented", "fuel_correspondence_Crypto.AEAD.Invariant.counterblocks.fuel_instrumented", + "fuel_correspondence_FStar.SeqProperties.seq_find_aux.fuel_instrumented", "fuel_guarded_inversion_Crypto.Symmetric.PRF.domain", "fuel_guarded_inversion_Crypto.Symmetric.PRF.entry", "fuel_guarded_inversion_Crypto.Symmetric.PRF.otp", @@ -4561,7 +4404,7 @@ "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_Flag.mac_log", "int_inversion", "int_typing", - "interpretation_Tm_abs_826608555216c536a7cbe67753c8fa74", + "interpretation_Tm_abs_10ac7d18029f5cdcfa8f14efda7b7748", "interpretation_Tm_arrow_60dded2fac76d116672c2a6bb6cdd1a7", "interpretation_Tm_arrow_9cb3c953faf527c316d427b2ce8bd81b", "kinding_Crypto.Symmetric.PRF.entry@tok", @@ -4576,8 +4419,11 @@ "lemma_FStar.Seq.lemma_len_append", "lemma_FStar.Seq.lemma_len_slice", "lemma_Flag.mac1_implies_mac_log", "lemma_Flag.mac1_implies_prf", "lemma_Flag.safeId_implies_mac1", + "lemma_Prims.invertOption", "pretyping_533d8a9fddfb9ab2d24280a2b80ade9f", + "pretyping_779086306c29597e3dd1127d16405da1", "pretyping_f537159ed795b314b4e58c260361ae86", + "pretyping_f8666440faa91836cc5a13998af863fc", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThan", @@ -4602,14 +4448,15 @@ "projection_inverse_FStar.Buffer.MkBuffer_idx", "projection_inverse_FStar.Buffer.MkBuffer_length", "projection_inverse_FStar.UInt32.Mk_v", - "projection_inverse_Prims.None_a", "projection_inverse_Prims.Some_v", + "projection_inverse_Prims.None_a", "projection_inverse_Prims.Some_a", + "projection_inverse_Prims.Some_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0991f788dbb220993dffda8c3c28b9ce", "refinement_interpretation_Tm_refine_124f9a17930ed5399c6ce9b2a0d8ee4a", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_1b6735750293b0f2d82400272c83fe68", "refinement_interpretation_Tm_refine_27eb738955e795e5dd1cab5fe18de9a0", - "refinement_interpretation_Tm_refine_2f2d14de9bf82f3f98518a5a27e71746", - "refinement_interpretation_Tm_refine_34818144cbb5575ece3ac2a163449e0c", + "refinement_interpretation_Tm_refine_2e09186152b6bcec91dd27c9dcd50774", "refinement_interpretation_Tm_refine_382dc0bac6b5ab79032637ee87d8f146", "refinement_interpretation_Tm_refine_411d85ef97ca9abbe60ec27c18002272", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", @@ -4620,51 +4467,59 @@ "refinement_interpretation_Tm_refine_7874c81428902f5ef0683ead2eab5830", "refinement_interpretation_Tm_refine_7cde9c8b6d2c1ee719f4650699d4658b", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_8206ae4d19246bfc0bed5cf762cb72ac", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47", "refinement_interpretation_Tm_refine_9579fa2db1a51848d754cc29acdc2303", + "refinement_interpretation_Tm_refine_9b9201ccbfd99139a24c221142f1d58d", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a03d17cbcfb5cdf8688062b52a884bd3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", - "refinement_interpretation_Tm_refine_b15dc250df6ac242c7d2a33a77c3908d", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_a917a802cdb0c45fe1a8176d288f4ee0", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_ba55e33baf8b5f033c2b5a3cb0b501f6", "refinement_interpretation_Tm_refine_bf508e8beb5acc14a1d69e7187345e9c", "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", - "refinement_interpretation_Tm_refine_c8c150a3a5ebfb73654ea86e2ea7fe35", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "refinement_interpretation_Tm_refine_cdddfd0d298ccc07c9315a3b3735d987", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", "refinement_interpretation_Tm_refine_d8c836153526ef1c21401cba1680996f", - "refinement_interpretation_Tm_refine_deb68a2ba9316e7f1502cc670399a37c", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9762ee78e152ec2f524cf343c6f0620", + "refinement_interpretation_Tm_refine_eb8f0a0ac9d8793518e02704d205443b", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "refinement_interpretation_Tm_refine_f99f7d98a295a9ce6a9cc6b7b4ead06e", "typing_Crypto.AEAD.Invariant.counterblocks", - "typing_Crypto.AEAD.Invariant.minNat", "typing_Crypto.AEAD.Lemmas.u", - "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Entry.range", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.Mkdomain.iv", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", + "typing_Crypto.AEAD.Lemmas.u", "typing_Crypto.Symmetric.AES.v", + "typing_Crypto.Symmetric.Bytes.sel_bytes", + "typing_Crypto.Symmetric.Cipher.blocklen", + "typing_Crypto.Symmetric.PRF.__proj__Entry__item__range", + "typing_Crypto.Symmetric.PRF.__proj__Entry__item__x", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__iv", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", + "typing_Crypto.Symmetric.PRF.above", "typing_Crypto.Symmetric.PRF.blocklen", + "typing_Crypto.Symmetric.PRF.find", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", - "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.sub", - "typing_FStar.HyperStack.MkRef.mm", "typing_FStar.HyperStack.sel", - "typing_FStar.Seq.append", "typing_FStar.Seq.create", - "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", - "typing_FStar.Seq.length", "typing_FStar.Seq.seq", - "typing_FStar.Seq.slice", "typing_FStar.SeqProperties.seq_find", + "typing_Crypto.Symmetric.PRF.range", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.length", + "typing_FStar.Buffer.sub", + "typing_FStar.HyperStack.__proj__MkRef__item__mm", + "typing_FStar.HyperStack.sel", "typing_FStar.Seq.append", + "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", + "typing_FStar.Seq.index", "typing_FStar.Seq.length", + "typing_FStar.Seq.seq", "typing_FStar.Seq.slice", + "typing_FStar.SeqProperties.seq_find", "typing_FStar.SeqProperties.snoc", "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", - "typing_FStar.UInt32.v", "typing_Flag.prf", "typing_Flag.safeHS", - "typing_Flag.safeId", "typing_Plain.as_buffer", + "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", + "typing_Flag.prf", "typing_Flag.safeHS", "typing_Plain.as_buffer", "typing_Plain.sel_plain", - "typing_Tm_abs_826608555216c536a7cbe67753c8fa74" + "typing_Tm_abs_10ac7d18029f5cdcfa8f14efda7b7748", "unit_inversion", + "unit_typing" ], 0 ], @@ -4849,23 +4704,24 @@ "typing_Crypto.AEAD.Invariant.counterblocks", "typing_Crypto.AEAD.Invariant.minNat", "typing_Crypto.AEAD.Lemmas.u", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.PRF.Entry.range", - "typing_Crypto.Symmetric.PRF.Mkdomain.ctr", - "typing_Crypto.Symmetric.PRF.Mkdomain.iv", - "typing_Crypto.Symmetric.PRF.State.mac_rgn", + "typing_Crypto.Symmetric.PRF.__proj__Empty__item__range", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__ctr", + "typing_Crypto.Symmetric.PRF.__proj__Mkdomain__item__iv", + "typing_Crypto.Symmetric.PRF.__proj__State__item__mac_rgn", "typing_Crypto.Symmetric.PRF.above", "typing_Crypto.Symmetric.PRF.blocklen", "typing_Crypto.Symmetric.PRF.maxCtr", - "typing_FStar.Buffer.MkBuffer.content", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.sub", - "typing_FStar.HyperStack.MkRef.mm", "typing_FStar.HyperStack.sel", - "typing_FStar.Seq.append", "typing_FStar.Seq.create", - "typing_FStar.Seq.createEmpty", "typing_FStar.Seq.index", - "typing_FStar.Seq.length", "typing_FStar.Seq.seq", - "typing_FStar.Seq.slice", "typing_FStar.SeqProperties.seq_find", + "typing_FStar.HyperStack.__proj__MkRef__item__mm", + "typing_FStar.HyperStack.sel", "typing_FStar.Seq.append", + "typing_FStar.Seq.create", "typing_FStar.Seq.createEmpty", + "typing_FStar.Seq.index", "typing_FStar.Seq.length", + "typing_FStar.Seq.seq", "typing_FStar.Seq.slice", + "typing_FStar.SeqProperties.seq_find", "typing_FStar.SeqProperties.snoc", "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", "typing_FStar.UInt32.v", "typing_Flag.prf", "typing_Flag.safeHS", @@ -4909,7 +4765,7 @@ [ "Crypto.AEAD.Lemmas.extending_counter_blocks", 44, - 0, + 1, 0, [ "@query", "equation_Crypto.AEAD.Lemmas.u", @@ -4923,8 +4779,8 @@ "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", "kinding_FStar.UInt8.t_@tok", "pretyping_ae567c2fb75be05905677af440075565", @@ -4935,11 +4791,12 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_2e09186152b6bcec91dd27c9dcd50774", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_c8c150a3a5ebfb73654ea86e2ea7fe35", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], @@ -4976,7 +4833,8 @@ "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c8c150a3a5ebfb73654ea86e2ea7fe35", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt32.Mk.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt32.__proj__Mk__item__v" ], 0 ], diff --git a/examples/low-level/crypto/Crypto.AEAD.fst b/examples/low-level/crypto/Crypto.AEAD.fst index 713bfafa082..d3971911510 100644 --- a/examples/low-level/crypto/Crypto.AEAD.fst +++ b/examples/low-level/crypto/Crypto.AEAD.fst @@ -31,7 +31,7 @@ module PRF = Crypto.Symmetric.PRF type region = rgn:HH.rid {HS.is_eternal_region rgn} -let ctr x = PRF(x.ctr) +let ctr x = PRF.(x.ctr) //16-10-12 TEMPORARY, while PRF remains somewhat CHACHA-specific //16-10-12 NB we are importing this restriction from Encoding too @@ -52,9 +52,10 @@ let id = Crypto.AEAD.Encoding.id // we can reason about sequence-number collisions before applying it. // TODO: prove, generalize and move -assume val lt_pow2_index_to_vec: n:nat -> x:UInt128.t -> Lemma - (requires FStar.UInt128(v x < pow2 n)) - (ensures FStar.UInt128(forall (i:nat). (i < 128 /\ i >= n) ==> + (* n defined in FStar.UInt128, so is shadowed. Thus, we have to rename n into n' *) +assume val lt_pow2_index_to_vec: n':nat -> x:UInt128.t -> Lemma + (requires FStar.UInt128.(v x < pow2 n')) + (ensures FStar.UInt128.(forall (i:nat). (i < 128 /\ i >= n') ==> Seq.index (FStar.UInt.to_vec (v x)) (127-i) = false)) // TODO: prove, generalize and move @@ -63,14 +64,17 @@ assume val index_to_vec_lt_pow2: n:nat -> x:FStar.BitVector.bv_t 128 -> Lemma (ensures (FStar.UInt.from_vec x < pow2 n)) // TODO: move -val lemma_xor_bounded: n:nat -> x:UInt128.t -> y:UInt128.t -> Lemma - (requires FStar.UInt128(v x < pow2 n /\ v y < pow2 n)) - (ensures FStar.UInt128(v (logxor x y) < pow2 n)) + (* n defined in FStar.UInt128, so is shadowed. Thus, we have to rename n into n' *) +val lemma_xor_bounded: n':nat -> x:UInt128.t -> y:UInt128.t -> Lemma + (requires FStar.UInt128.(v x < pow2 n' /\ v y < pow2 n')) + (ensures FStar.UInt128.(v (logxor x y) < pow2 n')) let lemma_xor_bounded n x y = + let n' = n in let open FStar.BitVector in let open FStar.UInt128 in let vx = FStar.UInt.to_vec (v x) in let vy = FStar.UInt.to_vec (v y) in + let n = n' in (* n defined in FStar.UInt128, so was shadowed, so renamed into n' *) lt_pow2_index_to_vec n x; lt_pow2_index_to_vec n y; lemma_xor_bounded 128 n vx vy; @@ -208,8 +212,8 @@ val counter_enxor: cipher:lbuffer (v len) { let bp = as_buffer plain in Buffer.disjoint bp cipher /\ - Buffer.frameOf bp <> (PRF t.rgn) /\ - Buffer.frameOf cipher <> (PRF t.rgn) + Buffer.frameOf bp <> (PRF.(t.rgn)) /\ + Buffer.frameOf cipher <> (PRF.(t.rgn)) } -> h_init:mem -> // STL unit -- NS: should be in STL, but the rest of the library isn't really in STL yet @@ -219,7 +223,7 @@ val counter_enxor: let completed_len = len -^ remaining_len in Plain.live h plain /\ Buffer.live h cipher /\ - (remaining_len <> 0ul ==> FStar.Mul ((v x.ctr - 1) * v (PRF.blocklen i) = v completed_len)) /\ + (remaining_len <> 0ul ==> FStar.Mul.((v x.ctr - 1) * v (PRF.blocklen i) = v completed_len)) /\ // if ciphertexts are authenticated, then fresh blocks are available none_above x t h /\ (safeId i @@ -279,9 +283,9 @@ let inv h #i #rw e = let blocks = HS.sel h r in let entries = HS.sel h log in h `HS.contains` r /\ - refines h i (PRF prf.mac_rgn) entries blocks ) + refines h i (PRF.(prf.mac_rgn)) entries blocks ) -let prf_state (#i:id) (#rw:rw) (e:state i rw) : PRF.state i = State.prf e +let prf_state (#i:id) (#rw:rw) (e:state i rw) : PRF.state i = State?.prf e val counter_dexor: i:id -> t:PRF.state i -> x:PRF.domain i{x.ctr <> 0ul} -> len:u32{safelen i (v len) x.ctr} -> @@ -289,8 +293,8 @@ val counter_dexor: cipher:lbuffer (v len) { let bp = as_buffer plain in Buffer.disjoint bp cipher /\ - Buffer.frameOf bp <> (PRF t.rgn) /\ - Buffer.frameOf cipher <> (PRF t.rgn) + Buffer.frameOf bp <> (PRF.(t.rgn)) /\ + Buffer.frameOf cipher <> (PRF.(t.rgn)) } -> STL unit (requires (fun h -> Plain.live h plain /\ @@ -304,7 +308,7 @@ val counter_dexor: Buffer.live h1 cipher /\ // in all cases, we extend the table only at x and its successors. modifies_table_above_x_and_buffer t x (as_buffer plain) h0 h1 /\ - (safeId i ==> Seq.equal #(PRF.entry (PRF t.mac_rgn) i) (HS.sel h1 t.table) (HS.sel h0 t.table)))) + (safeId i ==> Seq.equal #(PRF.entry (PRF.(t.mac_rgn)) i) (HS.sel h1 t.table) (HS.sel h0 t.table)))) let rec counter_dexor i t x len plaintext ciphertext = assume false;//16-10-12 @@ -316,12 +320,12 @@ let rec counter_dexor i t x len plaintext ciphertext = let plain = Plain.sub plaintext 0ul l in (* - recall (PRF t.table); //16-09-22 could this be done by ! ?? - let s = PRF !t.table in + recall (PRF.(t.table)); //16-09-22 could this be done by ! ?? + let s = PRF.( !t.table ) in let h = ST.get() in // WARNING: moving the PRF.find_otp outside the assume will segfault // at runtime, because t.table doesn't exist in real code - assume(match PRF.find_otp #(PRF.State.rgn t) #i s x with + assume(match PRF.find_otp #(PRF.State?.rgn t) #i s x with | Some (PRF.OTP l' p c) -> l == l' /\ c = sel_bytes h l cipher | None -> False); *) @@ -384,7 +388,7 @@ let encrypt i st n aadlen aad plainlen plain cipher_tagged = assume (safeId i); assume (prf i); let h0 = get() in - let x = PRF({iv = n; ctr = 0ul}) in // PRF index to the first block + let x = PRF.({iv = n; ctr = 0ul}) in // PRF index to the first block let ak = PRF.prf_mac i st.prf x in // used for keying the one-time MAC let h1 = get () in let cipher = Buffer.sub cipher_tagged 0ul plainlen in @@ -399,7 +403,7 @@ let encrypt i st n aadlen aad plainlen plain cipher_tagged = let h2 = get () in intro_refines_one_entry_no_tag #i st n (v plainlen) plain cipher_tagged h0 h1 h2; //we have pre_refines_one_entry here assert (Buffer.live h1 aad); //seem to need this hint - assume (HS (is_stack_region h2.tip)); //TODO: remove this once we move all functions to STL + assume (HS.(is_stack_region h2.tip)); //TODO: remove this once we move all functions to STL let l, acc = accumulate ak aadlen aad plainlen cipher in let h3 = get() in let _ = @@ -427,9 +431,9 @@ let encrypt i st n aadlen aad plainlen plain cipher_tagged = let t: lbuffer 16 = Buffer.as_seq h1 (Buffer.sub ciphertext plainlen (Spec.taglen i)) in let a = Buffer.as_seq h1 aadtext in let l = field_encode i a c in ( - match PRF.find_0 (HS.sel h1 (PRF.State.table e.prf)) (PRF({iv=n; ctr=0ul})) with + match PRF.find_0 (HS.sel h1 (PRF.State?.table e.prf)) (PRF.({iv=n; ctr=0ul})) with | Some mac -> - let log = MAC.ilog (MAC.State.log mac) in + let log = MAC.ilog (MAC.State?.log mac) in m_contains log h1 /\ m_sel h1 log == Some (l,t) | None -> False)) *) @@ -469,7 +473,7 @@ val decrypt: let decrypt i st iv aadlen aad plainlen plain cipher_tagged = push_frame(); - let x = PRF({iv = iv; ctr = 0ul}) in // PRF index to the first block + let x = PRF.({iv = iv; ctr = 0ul}) in // PRF index to the first block let ak = PRF.prf_mac i st.prf x in // used for keying the one-time MAC let cipher = Buffer.sub cipher_tagged 0ul plainlen in let tag = Buffer.sub cipher_tagged plainlen (Spec.taglen i) in @@ -477,7 +481,7 @@ let decrypt i st iv aadlen aad plainlen plain cipher_tagged = // First recompute and check the MAC let h0 = ST.get() in assume( - MAC(Buffer.live h0 ak.r /\ norm h0 ak.r) /\ + MAC.(Buffer.live h0 ak.r /\ norm h0 ak.r) /\ Buffer.live h0 aad /\ Buffer.live h0 cipher); let l, acc = accumulate ak aadlen aad plainlen cipher in @@ -488,7 +492,7 @@ let decrypt i st iv aadlen aad plainlen plain cipher_tagged = let verified = MAC.verify ak l acc tag in // let h1 = ST.get() in - // assert(mac_log /\ MAC.authId (i,iv) ==> (verified == (HS.sel h1 (MAC(ilog ak)) = Some (l,tag)))); + // assert(mac_log /\ MAC.authId (i,iv) ==> (verified == (HS.sel h1 (MAC.(ilog ak)) = Some (l,tag)))); // then, safeID i /\ stateful invariant ==> // not verified ==> no entry in the AEAD table diff --git a/examples/low-level/crypto/Crypto.Symmetric.AES.fst b/examples/low-level/crypto/Crypto.Symmetric.AES.fst index 33d966a3426..82ec827e1af 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.AES.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.AES.fst @@ -32,8 +32,8 @@ inline_for_extraction let nk = 8ul inline_for_extraction let nb = 4ul inline_for_extraction let nr = 14ul -let blocklen = U32(4ul *^ nb) -let keylen = U32(4ul *^ nk) +let blocklen = U32.(4ul *^ nb) +let keylen = U32.(4ul *^ nk) type block = lbytes (v blocklen) type wkey = lbytes (16 * (v nr+1)) @@ -209,10 +209,10 @@ let rec access_aux: sb:sbox -> byte -> ctr:UInt32.t{v ctr <= 256} -> byte -> STL (requires (fun h -> live h sb)) (ensures (fun h0 _ h1 -> h1 == h0)) = fun sbox i ctr tmp -> - if U32 (ctr =^ 256ul) then tmp + if U32.(ctr =^ 256ul) then tmp else let mask = eq_mask i (uint32_to_uint8 ctr) in let tmp = tmp |^ (mask &^ sbox.(ctr)) in - access_aux sbox i (U32 (ctr +^ 1ul)) tmp + access_aux sbox i (U32.(ctr +^ 1ul)) tmp val access: sb:sbox -> idx:byte -> STL byte (requires (fun h -> live h sb)) @@ -228,13 +228,13 @@ val subBytes_aux_sbox: state:block -> sb:sbox{disjoint state sb} -> (requires (fun h -> live h state /\ live h sb)) (ensures (fun h0 _ h1 -> live h1 state /\ modifies_1 state h0 h1)) let rec subBytes_aux_sbox state sbox ctr = - if U32 (ctr =^ 16ul) then () + if U32.(ctr =^ 16ul) then () else begin let si = state.(ctr) in let si' = access sbox si in state.(ctr) <- si'; - subBytes_aux_sbox state sbox (U32 (ctr +^ 1ul)) + subBytes_aux_sbox state sbox (U32.(ctr +^ 1ul)) end val subBytes_sbox: state:block -> sbox:sbox{disjoint state sbox} -> STL unit @@ -274,15 +274,15 @@ val mixColumns_: state:block -> c:UInt32.t{v c < 4} -> STL unit (requires (fun h -> live h state)) (ensures (fun h0 _ h1 -> live h1 state /\ modifies_1 state h0 h1)) let mixColumns_ state c = - let s = Buffer.sub state (H32(4ul*^c)) 4ul in + let s = Buffer.sub state (H32.(4ul*^c)) 4ul in let s0 = s.(0ul) in let s1 = s.(1ul) in let s2 = s.(2ul) in let s3 = s.(3ul) in - s.(0ul) <- H8 (multiply 0x2uy s0 ^^ multiply 0x3uy s1 ^^ s2 ^^ s3); - s.(1ul) <- H8 (multiply 0x2uy s1 ^^ multiply 0x3uy s2 ^^ s3 ^^ s0); - s.(2ul) <- H8 (multiply 0x2uy s2 ^^ multiply 0x3uy s3 ^^ s0 ^^ s1); - s.(3ul) <- H8 (multiply 0x2uy s3 ^^ multiply 0x3uy s0 ^^ s1 ^^ s2) + s.(0ul) <- H8.(multiply 0x2uy s0 ^^ multiply 0x3uy s1 ^^ s2 ^^ s3); + s.(1ul) <- H8.(multiply 0x2uy s1 ^^ multiply 0x3uy s2 ^^ s3 ^^ s0); + s.(2ul) <- H8.(multiply 0x2uy s2 ^^ multiply 0x3uy s3 ^^ s0 ^^ s1); + s.(3ul) <- H8.(multiply 0x2uy s3 ^^ multiply 0x3uy s0 ^^ s1 ^^ s2) #reset-options "--initial_fuel 0 --max_fuel 0" @@ -387,7 +387,7 @@ let rec rcon i tmp = if i = 1ul then tmp else begin let tmp = multiply 0x2uy tmp in - rcon (U32(i-^1ul)) tmp + rcon (U32.(i-^1ul)) tmp end #reset-options "--z3rlimit 20 --initial_fuel 0 --max_fuel 0" @@ -413,7 +413,7 @@ let keyExpansion_aux_0 w temp sbox j = subWord temp sbox; let t0 = temp.(0ul) in let rc = rcon ((i/^4ul)/^nk) 1uy in - let z = H8 (t0 ^^ rc) in + let z = H8.(t0 ^^ rc) in temp.(0ul) <- z ) else if ((i/^4ul) %^ nk) =^ 4ul then ( @@ -440,10 +440,10 @@ let keyExpansion_aux_1 w temp sbox j = let t1 = temp.(1ul) in let t2 = temp.(2ul) in let t3 = temp.(3ul) in - w.(i+^0ul) <- H8 (t0 ^^ w0); - w.(i+^1ul) <- H8 (t1 ^^ w1); - w.(i+^2ul) <- H8 (t2 ^^ w2); - w.(i+^3ul) <- H8 (t3 ^^ w3) + w.(i+^0ul) <- H8.(t0 ^^ w0); + w.(i+^1ul) <- H8.(t1 ^^ w1); + w.(i+^2ul) <- H8.(t2 ^^ w2); + w.(i+^3ul) <- H8.(t3 ^^ w3) val keyExpansion_aux: w:wkey -> temp:lbytes 4 -> sbox:sbox -> i:UInt32.t{v i <= 60 /\ v i >= v nk} -> STL unit (requires (fun h -> live h w /\ live h temp /\ live h sbox @@ -487,7 +487,7 @@ let rec invSubBytes_aux_sbox state sbox ctr = let si = state.(ctr) in let si' = access sbox si in state.(ctr) <- si'; - invSubBytes_aux_sbox state sbox (U32 (ctr+^1ul)) + invSubBytes_aux_sbox state sbox (U32.(ctr+^1ul)) end val invSubBytes_sbox: state:block -> sbox:sbox -> STL unit @@ -528,12 +528,12 @@ val invMixColumns_: state:block -> c:UInt32.t{v c < 4} -> STL unit (requires (fun h -> live h state)) (ensures (fun h0 _ h1 -> live h1 state /\ modifies_1 state h0 h1 )) let invMixColumns_ state c = - let s = Buffer.sub state (H32(4ul*^c)) 4ul in + let s = Buffer.sub state (H32.(4ul*^c)) 4ul in let s0 = s.(0ul) in let s1 = s.(1ul) in let s2 = s.(2ul) in let s3 = s.(3ul) in - let mix x0 x1 x2 x3 = H8 (multiply 0xeuy x0 ^^ multiply 0xbuy x1 ^^ multiply 0xduy x2 ^^ multiply 0x9uy x3) in + let mix x0 x1 x2 x3 = H8.(multiply 0xeuy x0 ^^ multiply 0xbuy x1 ^^ multiply 0xduy x2 ^^ multiply 0x9uy x3) in s.(0ul) <- mix s0 s1 s2 s3; s.(1ul) <- mix s1 s2 s3 s0; s.(2ul) <- mix s2 s3 s0 s1; diff --git a/examples/low-level/crypto/Crypto.Symmetric.AES.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.AES.fst.hints index 387cc174282..6e7597cd652 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.AES.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.AES.fst.hints @@ -1,5 +1,5 @@ [ - "\\9?md\u0012<>W]", + "($4$\u0012:7Q", [ [ "Crypto.Symmetric.AES.lbytes", @@ -165,11 +165,9 @@ "@query", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.mul", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "int_inversion", "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v" ], @@ -195,7 +193,7 @@ "equation_FStar.UInt8.n", "equation_Prims.nat", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", - "function_token_typing_FStar.Int8.n", "int_inversion", + "function_token_typing_FStar.Int8.n", "int_inversion", "int_typing", "lemma_FStar.Int.pow2_values", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_FStar.UInt32.Mk_v", @@ -204,7 +202,8 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -298,13 +297,14 @@ "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_3fe7cd6b96e8a6f977e2c1aa0070d019", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.Heap.domain", - "typing_FStar.HyperStack.HS.h", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -349,11 +349,11 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -363,9 +363,8 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", - "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", "bool_inversion", - "bool_typing", "data_elim_FStar.UInt32.Mk", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", @@ -374,13 +373,10 @@ "equation_Crypto.Symmetric.AES.lbytes", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", @@ -389,17 +385,16 @@ "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.eq", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Equals_Hat", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", "equation_Prims._assert", "equation_Prims.eqtype", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.blocklen", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", @@ -415,9 +410,7 @@ "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.HyperStack.HS_h", + "primitive_Prims.op_Multiply", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", @@ -425,17 +418,14 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_790772d82e6c5382184d4482620e08ca", "refinement_interpretation_Tm_refine_b7b814792f7e7ae55393d5f0d9526922", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt32.v", "unit_inversion" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -445,47 +435,44 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.bytes", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.HyperStack.mem", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", "primitive_Prims.op_Addition", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", + "primitive_Prims.op_Multiply", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_790772d82e6c5382184d4482620e08ca", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -495,9 +482,8 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", @@ -505,44 +491,37 @@ "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.nr", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.AES.nk", "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -553,8 +532,8 @@ 1, [ "@query", "b2t_def", "bool_inversion", "bool_typing", - "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.HyperStack.HS", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", @@ -565,33 +544,37 @@ "equation_FStar.Buffer.contains", "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", - "equation_FStar.HyperStack.contains", "equation_FStar.Int8.n", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.n", - "equation_FStar.UInt8.t", "equation_Prims.nat", - "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_above", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.HyperStack.is_tip", "equation_FStar.HyperStack.sid", + "equation_FStar.Int8.n", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_FStar.HyperHeap.root", "function_token_typing_FStar.Int8.n", "int_inversion", "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", - "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.modifies_subbuffer_1", + "lemma_FStar.HyperHeap.lemma_includes_anti_symmetric", + "lemma_FStar.HyperHeap.lemma_root_has_color_zero", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "lemma_FStar.Int.pow2_values", "primitive_Prims.op_Addition", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_FStar.Buffer.MkBuffer_content", - "proj_equation_FStar.Buffer.MkBuffer_idx", "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.Buffer.MkBuffer_max_length", "proj_equation_FStar.UInt32.Mk_v", @@ -599,15 +582,21 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_339344b990582799b75d84b6c53f9401", "refinement_interpretation_Tm_refine_3e671f3db1cc758075154f24623acdd2", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_7778e6829125aada02b932a3a2836fc5", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", + "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", "typing_FStar.UInt.fits", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.HyperHeap.includes", + "typing_FStar.HyperStack.is_stack_region", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 @@ -618,52 +607,42 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -673,9 +652,9 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.Buffer.MkBuffer", - "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", @@ -689,36 +668,34 @@ "equation_FStar.Buffer.contains", "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", - "equation_FStar.HyperStack.contains", - "equation_FStar.HyperStack.is_stack_region", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nb", - "function_token_typing_FStar.HyperHeap.root", "int_inversion", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_sub_", "lemma_FStar.Buffer.lemma_disjoint_symm", + "lemma_FStar.Buffer.lemma_live_disjoint", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.Buffer.lemma_size", "lemma_FStar.Buffer.modifies_subbuffer_1", "lemma_FStar.Buffer.no_upd_lemma_1", - "lemma_FStar.HyperHeap.lemma_root_has_color_zero", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "lemma_FStar.Int.pow2_values", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_FStar.Buffer.MkBuffer_content", + "proj_equation_FStar.Buffer.MkBuffer_idx", "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.Buffer.MkBuffer_max_length", "proj_equation_FStar.UInt32.Mk_v", @@ -731,15 +708,13 @@ "refinement_interpretation_Tm_refine_3e671f3db1cc758075154f24623acdd2", "refinement_interpretation_Tm_refine_790772d82e6c5382184d4482620e08ca", "refinement_interpretation_Tm_refine_8e2c8a87c1c28f18a84175f40ad659c3", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", "refinement_interpretation_Tm_refine_e7b67c17024141c2dad9fad4dbda426f", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", - "typing_FStar.HyperStack.is_stack_region", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Mul.op_Star", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], @@ -751,54 +726,51 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.v", - "equation_Crypto.Symmetric.AES.wkey", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.wkey", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.Buffer.no_upd_lemma_1", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_790772d82e6c5382184d4482620e08ca", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -808,24 +780,22 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", - "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", "bool_inversion", - "bool_typing", "data_elim_FStar.UInt32.Mk", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.rnd", "equation_Crypto.Symmetric.AES.sbox", "equation_Crypto.Symmetric.AES.v", - "equation_Crypto.Symmetric.AES.wkey", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.wkey", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", @@ -833,33 +803,33 @@ "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Star_Hat", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", - "equation_FStar.UInt8.t", "equation_Prims._assert", - "equation_Prims.eqtype", "equation_Prims.nat", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", + "equation_Prims._assert", "equation_Prims.eqtype", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.AES.nr", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt8.t_@tok", + "int_typing", "kinding_FStar.Heap.aref@tok", + "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.Buffer.lemma_modifies_sub_1", "lemma_FStar.Buffer.no_upd_lemma_1", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "lemma_FStar.Set.lemma_equal_refl", + "lemma_FStar.Int.pow2_values", "lemma_FStar.Set.lemma_equal_refl", "lemma_FStar.TSet.lemma_equal_refl", "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", @@ -868,18 +838,15 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_5823fb0a569551a2a3a2765139ac8d74", "refinement_interpretation_Tm_refine_790772d82e6c5382184d4482620e08ca", "refinement_interpretation_Tm_refine_8e2c8a87c1c28f18a84175f40ad659c3", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt32.v", "unit_inversion" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -966,12 +933,13 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Crypto.Symmetric.AES.v", "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", "typing_FStar.HyperStack.poppable", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "typing_Prims.pow2" ], @@ -991,52 +959,42 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.bytes", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims._assert", "equation_Prims.nat", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims._assert", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -1054,51 +1012,47 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.bytes", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.Buffer.no_upd_lemma_1", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -1127,7 +1081,7 @@ "fuel_guarded_inversion_FStar.UInt8.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", - "function_token_typing_FStar.Int8.n", "int_inversion", + "function_token_typing_FStar.Int8.n", "int_inversion", "int_typing", "lemma_FStar.Int.pow2_values", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", @@ -1138,8 +1092,8 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_be901cfcb091616ccd980fd474390614", - "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v", - "well-founded-ordering-on-nat" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v", "well-founded-ordering-on-nat" ], 0 ], @@ -1223,17 +1177,19 @@ "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_in", "equation_FStar.Int8.n", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.add", "equation_FStar.UInt.div", - "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", - "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt32.add", "equation_FStar.UInt32.div", + "equation_FStar.UInt.eq", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.add", + "equation_FStar.UInt32.div", "equation_FStar.UInt32.eq", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", - "equation_Prims._assert", + "equation_Prims._assert", "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.AES.nk", @@ -1247,8 +1203,9 @@ "lemma_FStar.Int.pow2_values", "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.UInt32.Mk_v", @@ -1258,14 +1215,15 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_814770d986f06f66b84225be16b5517a", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_30f506529c8fc1d30f29ba14a0f04cd4", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ae8793eeb97f93b06886b04c9659ffec", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.is_in", - "typing_FStar.Mul.op_Star", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.v", "unit_inversion" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.is_in", "typing_FStar.Mul.op_Star", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -1322,13 +1280,14 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ae8793eeb97f93b06886b04c9659ffec", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c54dcb782be971742f65876a3620f44b", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.Mul.op_Star", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Mul.op_Star", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -1397,13 +1356,14 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_ca1f62cf5f6875b0d6832eb100cd8f8d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.is_in", - "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.is_in", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -1420,14 +1380,12 @@ "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.AES.xkey", "equation_FStar.Buffer.buffer", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.mul", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", "equation_Prims._assert", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", + "function_token_typing_FStar.List.Tot.test_sort", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24" @@ -1440,7 +1398,8 @@ 0, 1, [ - "@query", "b2t_def", "data_elim_FStar.HyperStack.HS", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "data_elim_FStar.HyperStack.HS", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", @@ -1453,10 +1412,13 @@ "equation_Crypto.Symmetric.AES.xkey", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.HyperStack.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.map_invariant", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.frameOf", "equation_FStar.HyperStack.fresh_frame", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_in", "equation_FStar.HyperStack.is_tip", "equation_FStar.HyperStack.live_region", "equation_FStar.HyperStack.pop", @@ -1469,12 +1431,15 @@ "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", - "equation_Prims.nat", "equation_Prims.pos", + "equation_Prims.eqtype", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", "function_token_typing_FStar.Int8.n", "int_inversion", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_symm", @@ -1490,21 +1455,35 @@ "lemma_FStar.Buffer.no_upd_lemma_0", "lemma_FStar.Buffer.no_upd_lemma_1", "lemma_FStar.HyperStack.lemma_equal_domains_trans", + "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "primitive_Prims.op_disEquality", + "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.HyperStack.HS_tip", + "proj_equation_FStar.HyperStack.MkRef_id", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Crypto.Symmetric.AES.v", "typing_FStar.Buffer.MkBuffer.idx", + "refinement_kinding_Tm_refine_8e561ff83f56135ffaf292b237824306", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.HyperHeap.includes", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.__proj__MkRef__item__id", + "typing_FStar.HyperStack.poppable", "typing_FStar.Map.contains", "typing_FStar.UInt32.v", "typing_Prims.pow2" ], 0 @@ -1515,9 +1494,8 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", - "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", "bool_inversion", - "bool_typing", "data_elim_FStar.UInt32.Mk", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", @@ -1526,13 +1504,10 @@ "equation_Crypto.Symmetric.AES.lbytes", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", @@ -1540,17 +1515,16 @@ "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Star_Hat", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", - "equation_FStar.UInt8.t", "equation_Prims._assert", - "equation_Prims.eqtype", "equation_Prims.nat", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", + "equation_Prims._assert", "equation_Prims.eqtype", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.blocklen", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", @@ -1566,9 +1540,7 @@ "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.HyperStack.HS_h", + "primitive_Prims.op_Multiply", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", @@ -1576,16 +1548,13 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_b7b814792f7e7ae55393d5f0d9526922", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt32.v", "unit_inversion" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -1606,46 +1575,44 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.bytes", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", + "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.HyperStack.mem", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", "primitive_Prims.op_Addition", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", + "primitive_Prims.op_Multiply", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], 0 ], @@ -1655,9 +1622,8 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", @@ -1665,47 +1631,39 @@ "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", "equation_Crypto.Symmetric.AES.nr", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims._assert", "equation_Prims.nat", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims._assert", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.AES.nk", "function_token_typing_Crypto.Symmetric.AES.nr", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -1716,8 +1674,8 @@ 1, [ "@query", "b2t_def", "bool_inversion", "bool_typing", - "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.HyperStack.HS", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", @@ -1729,17 +1687,19 @@ "equation_FStar.Buffer.contains", "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", - "equation_FStar.HyperStack.contains", - "equation_FStar.HyperStack.is_stack_region", "equation_FStar.Int8.n", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.n", - "equation_FStar.UInt8.t", "equation_Prims.nat", - "fuel_guarded_inversion_FStar.Buffer._buffer", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_above", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.HyperStack.is_tip", "equation_FStar.HyperStack.sid", + "equation_FStar.Int8.n", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", @@ -1751,6 +1711,7 @@ "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.Buffer.modifies_subbuffer_1", + "lemma_FStar.HyperHeap.lemma_includes_anti_symmetric", "lemma_FStar.HyperHeap.lemma_root_has_color_zero", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "lemma_FStar.Int.pow2_values", "primitive_Prims.op_Addition", @@ -1758,7 +1719,6 @@ "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "proj_equation_FStar.Buffer.MkBuffer_content", - "proj_equation_FStar.Buffer.MkBuffer_idx", "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.Buffer.MkBuffer_max_length", "proj_equation_FStar.UInt32.Mk_v", @@ -1766,16 +1726,20 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_339344b990582799b75d84b6c53f9401", "refinement_interpretation_Tm_refine_3e671f3db1cc758075154f24623acdd2", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_7778e6829125aada02b932a3a2836fc5", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.HyperHeap.includes", "typing_FStar.HyperStack.is_stack_region", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], @@ -1787,52 +1751,42 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", "b2t_def", - "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.AES.block", + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", "equation_Crypto.Symmetric.AES.keylen", "equation_Crypto.Symmetric.AES.lbytes", "equation_Crypto.Symmetric.AES.nb", "equation_Crypto.Symmetric.AES.nk", - "equation_Crypto.Symmetric.AES.nr", - "equation_Crypto.Symmetric.AES.v", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", + "equation_FStar.UInt8.t", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nr", "int_inversion", - "kinding_FStar.UInt8.t_@tok", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", "lemma_FStar.HyperStack.lemma_equal_domains_trans", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.UInt32.Mk_v", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.HyperStack.sel" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.v" ], 0 ], @@ -1842,9 +1796,8 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.AES.MaxUInt32", - "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", "bool_inversion", - "bool_typing", "data_elim_FStar.UInt32.Mk", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", @@ -1855,11 +1808,10 @@ "equation_Crypto.Symmetric.AES.nr", "equation_Crypto.Symmetric.AES.sbox", "equation_Crypto.Symmetric.AES.v", - "equation_Crypto.Symmetric.AES.xkey", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.live", "equation_FStar.Buffer.max_length", - "equation_FStar.Buffer.sel", "equation_FStar.HyperHeap.contains_ref", + "equation_Crypto.Symmetric.AES.xkey", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.contains", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", @@ -1868,15 +1820,15 @@ "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.eq", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Equals_Hat", - "equation_FStar.UInt32.op_Star_Hat", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.t", "equation_Prims._assert", "equation_Prims.eqtype", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", "function_token_typing_Crypto.Symmetric.AES.nr", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", @@ -1891,10 +1843,10 @@ "lemma_FStar.Set.lemma_equal_refl", "lemma_FStar.TSet.lemma_equal_refl", "pretyping_6c86c071b92797cdf01eb016249a9465", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", @@ -1903,16 +1855,16 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_3014ab05744cfd0d05bef0aefe1131e0", "refinement_interpretation_Tm_refine_3b81f81a034a2aecd1435c9e044c8c87", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.Mkbuffer_.content", - "typing_FStar.Buffer.bounded_seq", "typing_FStar.Buffer.idx", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.sel", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "unit_inversion" + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -1922,8 +1874,9 @@ 0, 1, [ - "@query", "b2t_def", "bool_inversion", "bool_typing", - "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.HyperStack.HS", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "data_elim_FStar.Buffer.MkBuffer", + "data_elim_FStar.HyperStack.HS", "data_elim_FStar.HyperStack.MkRef", "data_elim_FStar.UInt32.Mk", "equation_Crypto.Symmetric.AES.block", "equation_Crypto.Symmetric.AES.blocklen", "equation_Crypto.Symmetric.AES.bytes", @@ -1937,11 +1890,13 @@ "equation_Crypto.Symmetric.AES.xkey", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", - "equation_FStar.HyperStack.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.map_invariant", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.frameOf", "equation_FStar.HyperStack.fresh_frame", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_in", "equation_FStar.HyperStack.is_tip", "equation_FStar.HyperStack.live_region", "equation_FStar.HyperStack.poppable", "equation_FStar.Int8.n", @@ -1953,14 +1908,18 @@ "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", "equation_FStar.UInt8.byte", "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", - "equation_Prims.nat", "equation_Prims.pos", + "equation_Prims.eqtype", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.HyperStack.reference", "fuel_guarded_inversion_FStar.UInt32.t_", "function_token_typing_Crypto.Symmetric.AES.keylen", - "function_token_typing_Crypto.Symmetric.AES.nb", - "function_token_typing_FStar.Int8.n", "int_inversion", "int_typing", + "function_token_typing_Crypto.Symmetric.AES.nr", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.Int8.n", "int_inversion", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_equal_domains_2", @@ -1975,26 +1934,34 @@ "lemma_FStar.Buffer.no_upd_lemma_0", "lemma_FStar.Buffer.no_upd_lemma_1", "lemma_FStar.HyperStack.lemma_equal_domains_trans", + "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "primitive_Prims.op_disEquality", + "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.Buffer.MkBuffer_idx", - "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.HyperStack.HS_tip", + "proj_equation_FStar.HyperStack.MkRef_id", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Crypto.Symmetric.AES.v", "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.HyperStack.poppable", "typing_FStar.UInt.fits", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.HyperHeap.includes", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.poppable", "typing_FStar.Map.contains", "typing_FStar.UInt32.v", "typing_Prims.pow2" ], 0 diff --git a/examples/low-level/crypto/Crypto.Symmetric.Bytes.fst b/examples/low-level/crypto/Crypto.Symmetric.Bytes.fst index c15f682aad2..4f1dd1f2fd9 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Bytes.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Bytes.fst @@ -31,8 +31,8 @@ type lbuffer (l:nat) = b:buffer {Buffer.length b == l} let uint128_to_uint8 (a:UInt128.t) : Tot (b:UInt8.t{UInt8.v b == UInt128.v a % pow2 8}) = uint64_to_uint8 (uint128_to_uint64 a) -private let hex1 (x:UInt8.t {FStar.UInt8(x <^ 16uy)}) = - FStar.UInt8( +private let hex1 (x:UInt8.t {FStar.UInt8.(x <^ 16uy)}) = + FStar.UInt8.( if x <^ 10uy then UInt8.to_string x else if x = 10uy then "a" else if x = 11uy then "b" else @@ -40,7 +40,7 @@ private let hex1 (x:UInt8.t {FStar.UInt8(x <^ 16uy)}) = if x = 13uy then "d" else if x = 14uy then "e" else "f") private let hex2 x = - FStar.UInt8(hex1 (x /^ 16uy) ^ hex1 (x %^ 16uy)) + FStar.UInt8.(hex1 (x /^ 16uy) ^ hex1 (x %^ 16uy)) val print_buffer: s:buffer -> i:UInt32.t{UInt32.v i <= length s} -> len:UInt32.t{UInt32.v len <= length s} -> Stack unit (requires (fun h -> live h s)) @@ -272,7 +272,8 @@ let rec load_uint32 len buf = let n = load_uint32 len (sub buf 1ul len) in let b = buf.(0ul) in assert_norm (pow2 8 == 256); - FStar.UInt32(uint8_to_uint32 b +^ 256ul *^ n) + let n' = n in (* n defined in FStar.UInt32, so was shadowed, so renamed into n' *) + FStar.UInt32.(uint8_to_uint32 b +^ 256ul *^ n') val load_big32: len:UInt32.t { v len <= 4 } -> buf:lbuffer (v len) -> ST UInt32.t (requires (fun h0 -> live h0 buf)) @@ -286,7 +287,8 @@ let rec load_big32 len buf = let n = load_big32 len (sub buf 0ul len) in let b = buf.(len) in assert_norm (pow2 8 == 256); - FStar.UInt32(uint8_to_uint32 b +^ 256ul *^ n) + let n' = n in (* n defined in FStar.UInt32, so was shadowed, so renamed into n' *) + FStar.UInt32.(uint8_to_uint32 b +^ 256ul *^ n') (** Used e.g. for converting TLS sequence numbers into AEAD nonces *) #reset-options "--z3rlimit 100" @@ -302,7 +304,8 @@ let rec load_big64 len buf = let n = load_big64 len (sub buf 0ul len) in let b = buf.(len) in assert_norm (pow2 8 == 256); - FStar.UInt64(uint8_to_uint64 b +^ 256UL *^ n) + let n' = n in (* n defined in FStar.UInt64, so was shadowed, so renamed into n' *) + FStar.UInt64.(uint8_to_uint64 b +^ 256UL *^ n') (* TODO: Add to FStar.Int.Cast and Kremlin and OCaml implementations *) @@ -327,7 +330,8 @@ let rec load_uint128 len buf = assert_norm (256 * pow2 (8 * 16 - 8) - 256 <= pow2 128 - 256); Math.Lemmas.pow2_le_compat (8 * 16 - 8) (8 * v len - 8); assert (256 * pow2 (8 * v len - 8) - 256 <= pow2 128 - 256); - FStar.UInt128(uint8_to_uint128 b +^ uint64_to_uint128 256UL *^ n) + let n' = n in (* n defined in FStar.UInt128, so was shadowed, so renamed into n' *) + FStar.UInt128.(uint8_to_uint128 b +^ uint64_to_uint128 256UL *^ n') (* stores a machine integer into a buffer of len bytes *) // 16-10-02 subsumes Buffer.Utils.bytes_of_uint32 ? @@ -343,7 +347,8 @@ let rec store_uint32 len buf n = if len <> 0ul then let len = len -^ 1ul in let b = uint32_to_uint8 n in - let n' = FStar.UInt32(n >>^ 8ul) in + let n1 = n in (* n defined in FStar.UInt32, so was shadowed, so renamed into n1 *) + let n' = FStar.UInt32.(n1 >>^ 8ul) in assert(v n = UInt8.v b + 256 * v n'); let buf' = Buffer.sub buf 1ul len in Math.Lemmas.pow2_plus 8 (8 * v len); @@ -362,7 +367,8 @@ let rec uint32_bytes len n = else let len = len -^ 1ul in let byte = uint32_to_uint8 n in - let n' = FStar.UInt32(n >>^ 8ul) in + let n1 = n in (* n defined in FStar.UInt32, so was shadowed, so renamed into n1 *) + let n' = FStar.UInt32.(n1 >>^ 8ul) in assert(v n = UInt8.v byte + 256 * v n'); Math.Lemmas.pow2_plus 8 (8 * v len); assert_norm (pow2 8 == 256); @@ -384,7 +390,8 @@ let rec store_uint128 len buf n = if len <> 0ul then let len = len -^ 1ul in let b = uint128_to_uint8 n in - let n' = FStar.UInt128(n >>^ 8ul) in + let n1 = n in (* n defined in FStar.UInt128, so was shadowed, so renamed into n1 *) + let n' = FStar.UInt128.(n1 >>^ 8ul) in assert(UInt128.v n = UInt8.v b + 256 * UInt128.v n'); let buf' = Buffer.sub buf 1ul len in Math.Lemmas.pow2_plus 8 (8 * v len); diff --git a/examples/low-level/crypto/Crypto.Symmetric.Chacha20.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Chacha20.fst.hints index f560fc7b36a..95b050f3acf 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Chacha20.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Chacha20.fst.hints @@ -52,12 +52,12 @@ 1, [ "@query", "b2t_def", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.Chacha20.keylen", + "equation_Crypto.Symmetric.Chacha20.blocklen", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "function_token_typing_Crypto.Symmetric.Chacha20.keylen", + "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", @@ -152,7 +152,7 @@ "equation_Crypto.Symmetric.Chacha20.matrix", "equation_FStar.Buffer.buffer", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "kinding_FStar.UInt32.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", @@ -178,22 +178,21 @@ "equation_Crypto.Symmetric.Chacha20.ivlen", "equation_Crypto.Symmetric.Chacha20.keylen", "equation_Crypto.Symmetric.Chacha20.matrix", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.uint_to_t", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Chacha20.ivlen", "function_token_typing_Crypto.Symmetric.Chacha20.keylen", "kinding_FStar.UInt32.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", - "lemma_FStar.Buffer.lemma_size", "lemma_FStar.HyperStack.lemma_equal_domains_trans", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "proj_equation_FStar.UInt32.Mk_v", @@ -201,9 +200,7 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_5fd76f96dd8842f1d4e9ef690b5c4ee7", - "refinement_interpretation_Tm_refine_cc511f1a3ab868e8a85dd97241911015", - "typing_FStar.UInt32.v" + "refinement_interpretation_Tm_refine_cc511f1a3ab868e8a85dd97241911015" ], 0 ], @@ -220,15 +217,15 @@ "equation_Crypto.Symmetric.Chacha20.ivlen", "equation_Crypto.Symmetric.Chacha20.keylen", "equation_Crypto.Symmetric.Chacha20.matrix", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Chacha20.ivlen", @@ -259,15 +256,15 @@ "equation_Crypto.Symmetric.Chacha20.ivlen", "equation_Crypto.Symmetric.Chacha20.keylen", "equation_Crypto.Symmetric.Chacha20.matrix", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Chacha20.ivlen", @@ -296,7 +293,7 @@ "equation_Crypto.Symmetric.Chacha20.blocklen", "equation_Crypto.Symmetric.Chacha20.matrix", "equation_FStar.Buffer.buffer", "equation_FStar.UInt32.t", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "kinding_FStar.UInt32.t_@tok", "lemma_FStar.Buffer.lemma_modifies_1_trans", @@ -386,16 +383,17 @@ "refinement_interpretation_Tm_refine_3f7e85595649c358dcf0c18849452103", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_420b2160cc4500dcd3c0d181b3755a91", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_cc511f1a3ab868e8a85dd97241911015", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.length", "typing_FStar.Heap.domain", - "typing_FStar.HyperStack.HS.h", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt32.v", "unit_inversion" + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt32.v", "unit_inversion" ], 0 ], @@ -521,17 +519,16 @@ "equation_Crypto.Symmetric.Chacha20.ivlen", "equation_Crypto.Symmetric.Chacha20.keylen", "equation_Crypto.Symmetric.Chacha20.matrix", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.UInt.fits", "equation_FStar.UInt.lt", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.lt", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.op_Less_Hat", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt32.v", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Chacha20.ivlen", @@ -592,7 +589,7 @@ "function_token_typing_Crypto.Symmetric.Chacha20.keylen", "function_token_typing_FStar.UInt32.n", "kinding_FStar.UInt32.t_@tok", "kinding_FStar.UInt8.t_@tok", - "lemma_FStar.Buffer.lemma_disjoint_sub", + "lemma_FStar.Buffer.lemma_disjoint_sub_", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_modifies_1_1", "lemma_FStar.Buffer.lemma_modifies_1_trans", @@ -614,11 +611,11 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_90c17150abf5cdb4d91f504ab07d9689", "refinement_interpretation_Tm_refine_a1efce34877d8df8ace630c84fbf073e", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_fd38c3aee4945c96a8f0fb038eab75e6", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.length", "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" ], @@ -630,10 +627,11 @@ 0, 1, [ - "@query", "b2t_def", "bool_inversion", "bool_typing", - "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.HyperStack.HS", - "data_elim_FStar.UInt32.Mk", "equation_Buffer.Utils.bytes", - "equation_Buffer.Utils.u32", "equation_Buffer.Utils.u8", + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.Buffer.MkBuffer", + "data_elim_FStar.HyperStack.HS", "data_elim_FStar.UInt32.Mk", + "equation_Buffer.Utils.bytes", "equation_Buffer.Utils.u32", + "equation_Buffer.Utils.u8", "equation_Crypto.Symmetric.Chacha20.blocklen", "equation_Crypto.Symmetric.Chacha20.iv", "equation_Crypto.Symmetric.Chacha20.ivlen", @@ -643,25 +641,32 @@ "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.idx", "equation_FStar.Buffer.includes", - "equation_FStar.Buffer.live", "equation_FStar.HyperStack.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.map_invariant", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", "equation_FStar.HyperStack.equal_domains", "equation_FStar.HyperStack.frameOf", "equation_FStar.HyperStack.fresh_frame", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_in", "equation_FStar.HyperStack.is_tip", "equation_FStar.HyperStack.live_region", - "equation_FStar.HyperStack.poppable", + "equation_FStar.HyperStack.poppable", "equation_FStar.Int16.n", "equation_FStar.ST.inline_stack_inv", "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.t", + "equation_FStar.UInt8.t", "equation_Prims.eqtype", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.HyperStack.reference", "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", "function_token_typing_Crypto.Symmetric.Chacha20.keylen", - "function_token_typing_FStar.UInt32.n", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.Int16.n", + "function_token_typing_FStar.UInt32.n", "int_typing", "kinding_FStar.UInt32.t_@tok", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_equal_domains_2", @@ -676,23 +681,34 @@ "lemma_FStar.Buffer.modifies_subbuffer_1", "lemma_FStar.Buffer.no_upd_lemma_0", "lemma_FStar.HyperStack.lemma_equal_domains_trans", + "pretyping_6c86c071b92797cdf01eb016249a9465", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Subtraction", "primitive_Prims.op_disEquality", "proj_equation_FStar.Buffer.MkBuffer_content", "proj_equation_FStar.HyperStack.HS_h", "proj_equation_FStar.HyperStack.HS_tip", + "proj_equation_FStar.HyperStack.MkRef_id", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_90c17150abf5cdb4d91f504ab07d9689", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", - "typing_FStar.Buffer.MkBuffer.content", + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", + "refinement_kinding_Tm_refine_8e561ff83f56135ffaf292b237824306", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", "typing_FStar.Buffer.content", "typing_FStar.Buffer.length", - "typing_FStar.HyperStack.poppable", "typing_FStar.UInt.fits" + "typing_FStar.HyperHeap.includes", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.__proj__MkRef__item__id", + "typing_FStar.HyperStack.poppable", "typing_FStar.Map.contains", + "typing_FStar.UInt.fits" ], 0 ], @@ -825,16 +841,16 @@ "refinement_interpretation_Tm_refine_65972e18bf7e31a999cc1c16590a2049", "refinement_interpretation_Tm_refine_9c4e5413079bc084a1602a7ec39c6c0a", "refinement_interpretation_Tm_refine_9d1111c1b1fd7d2d138f21d0ebdf9fae", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.idx", - "typing_FStar.Buffer.MkBuffer.length", - "typing_FStar.Buffer.MkBuffer.max_length", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", "typing_FStar.Buffer.length", "typing_FStar.Heap.domain", - "typing_FStar.HyperStack.HS.h", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.UInt.fits", - "typing_FStar.UInt32.v", "unit_inversion" + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v", "unit_inversion" ], 0 ] diff --git a/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst b/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst index dbf2e67c655..65373238918 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst @@ -26,8 +26,10 @@ let blocklen = function //| AES128 -> 16ul | AES256 -> 16ul | CHACHA20 -> 64ul +private let blocklen' = blocklen (* blocklen may be shadowed by Crypto.Symmetric.AES *) let ivlen (a:alg) = 12ul +private let ivlen' = ivlen (* ivlen may be shadowed by Crypto.Symmetric.Chacha20 *) type ctr = UInt32.t @@ -75,6 +77,7 @@ let compute a output k n counter len = begin match a with | CHACHA20 -> // already specialized for counter mode let open Crypto.Symmetric.Chacha20 in + let ivlen = ivlen' in (* to undo shadowing by Crypto.Symmetric.Chacha20 *) let nbuf = Buffer.create 0uy (ivlen CHACHA20) in store_uint128 (ivlen CHACHA20) nbuf n; chacha20 output k nbuf counter len @@ -87,6 +90,7 @@ let compute a output k n counter len = let w: xkey = Buffer.create 0uy (4ul *^ nb *^ (nr+^1ul)) in mk_sbox sbox; keyExpansion k w sbox; + let blocklen = blocklen' in (* to undo shadowing by Crypto.Symmetric.AES *) let ctr_block = Buffer.create 0uy (blocklen AES256) in store_uint128 (ivlen AES256) (Buffer.sub ctr_block 0ul (ivlen AES256)) n; // blit n 0ul ctr_block 0ul 12ul; diff --git a/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst.hints index 311f390cd16..bc2d17308c2 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Cipher.fst.hints @@ -7,7 +7,9 @@ 0, 1, [ - "@query", "data_elim_FStar.UInt32.Mk", + "@query", "constructor_distinct_Crypto.Symmetric.Cipher.AES256", + "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", + "data_elim_FStar.UInt32.Mk", "disc_equation_Crypto.Symmetric.Cipher.AES256", "disc_equation_Crypto.Symmetric.Cipher.CHACHA20", "equation_Crypto.Symmetric.AES.keylen", @@ -39,7 +41,9 @@ 0, 1, [ - "@query", "data_elim_FStar.UInt32.Mk", + "@query", "constructor_distinct_Crypto.Symmetric.Cipher.AES256", + "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", + "data_elim_FStar.UInt32.Mk", "disc_equation_Crypto.Symmetric.Cipher.AES256", "disc_equation_Crypto.Symmetric.Cipher.CHACHA20", "equation_Crypto.Symmetric.AES.blocklen", diff --git a/examples/low-level/crypto/Crypto.Symmetric.GCM.fst b/examples/low-level/crypto/Crypto.Symmetric.GCM.fst index e25a06a1dcc..8f0490871e3 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.GCM.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.GCM.fst @@ -112,16 +112,16 @@ private val encrypt_loop: #k:pos -> alg:cipher_alg k -> /\ modifies_2 ciphertext tmp h0 h1)) let rec encrypt_loop #k alg ciphertext key cnt plaintext len tmp dep = (* Appending zeros if the last block is not a complete one. *) - if U32 (16ul >=^ (len -^ dep)) then begin + if U32.(16ul >=^ (len -^ dep)) then begin let h0 = ST.get() in let counter = sub tmp 0ul 16ul in update_counter counter cnt; let last = sub tmp 16ul 16ul in - blit plaintext dep last 0ul (U32 (len -^ dep)); + blit plaintext dep last 0ul (U32.(len -^ dep)); let ci = sub tmp 32ul 16ul in alg key counter ci; gf128_add ci last; - blit ci 0ul ciphertext dep (U32 (len -^ dep)); + blit ci 0ul ciphertext dep (U32.(len -^ dep)); let h1 = ST.get() in assert(live h1 ciphertext /\ live h1 key /\ live h1 plaintext /\ live h1 tmp /\ modifies_2 ciphertext tmp h0 h1) end else begin @@ -132,7 +132,7 @@ let rec encrypt_loop #k alg ciphertext key cnt plaintext len tmp dep = let ci = sub ciphertext dep 16ul in alg key counter ci; gf128_add ci pi; - encrypt_loop #k alg ciphertext key (U32 (cnt +%^ 1ul)) plaintext len tmp (U32 (dep +^ 16ul)); + encrypt_loop #k alg ciphertext key (U32.(cnt +%^ 1ul)) plaintext len tmp (U32.(dep +^ 16ul)); let h1 = ST.get() in assert(live h1 ciphertext /\ live h1 key /\ live h1 plaintext /\ live h1 tmp /\ modifies_2 ciphertext tmp h0 h1) end @@ -157,7 +157,7 @@ let encrypt_body #k alg ciphertext tag key nonce cnt ad adlen plaintext len = push_frame(); let tmp = create (0uy) 48ul in blit nonce 0ul tmp 0ul 12ul; - encrypt_loop #k alg ciphertext key (U32 (cnt +%^ 1ul)) plaintext len tmp 0ul; + encrypt_loop #k alg ciphertext key (U32.(cnt +%^ 1ul)) plaintext len tmp 0ul; authenticate #k alg ciphertext tag key nonce cnt ad adlen len; pop_frame() diff --git a/examples/low-level/crypto/Crypto.Symmetric.GF128.fst b/examples/low-level/crypto/Crypto.Symmetric.GF128.fst index c826058c10c..cdc45e64c78 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.GF128.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.GF128.fst @@ -29,12 +29,12 @@ type elemB = b:lbuffer 16 private val gf128_add_loop: a:elemB -> b:elemB {disjoint a b} -> - dep:u32{U32(dep <=^ len)} -> Stack unit + dep:u32{U32.(dep <=^ len)} -> Stack unit (requires (fun h -> live h a /\ live h b)) (ensures (fun h0 _ h1 -> live h1 a /\ modifies_1 a h0 h1)) let rec gf128_add_loop a b dep = if dep <> 0ul then begin - let i = U32 (dep -^ 1ul) in + let i = U32.(dep -^ 1ul) in a.(i) <- a.(i) ^^ b.(i); gf128_add_loop a b i end @@ -45,14 +45,14 @@ val gf128_add: a:elemB -> b:elemB {disjoint a b} -> Stack unit (ensures (fun h0 _ h1 -> live h1 a /\ modifies_1 a h0 h1)) let gf128_add a b = gf128_add_loop a b len -private val gf128_shift_right_loop: a:elemB -> dep:u32{U32(dep <^ len)} -> Stack unit +private val gf128_shift_right_loop: a:elemB -> dep:u32{U32.(dep <^ len)} -> Stack unit (requires (fun h -> live h a)) (ensures (fun h0 _ h1 -> live h1 a /\ modifies_1 a h0 h1)) let rec gf128_shift_right_loop a dep = if dep = 0ul then a.(0ul) <- shift_right a.(0ul) 1ul else begin - let i = U32 (dep -^ 1ul) in + let i = U32.(dep -^ 1ul) in a.(dep) <- (a.(i) <<^ 7ul) +%^ (a.(dep) >>^ 1ul); gf128_shift_right_loop a i end @@ -76,7 +76,7 @@ private val apply_mask_loop: a:elemB -> m:elemB {disjoint a m} -> msk:byte -> de let rec apply_mask_loop a m msk dep = if dep <> 0ul then begin - let i = U32 (dep -^ 1ul) in + let i = U32.(dep -^ 1ul) in m.(i) <- a.(i) &^ msk; apply_mask_loop a m msk i end @@ -100,7 +100,7 @@ let rec gf128_mul_loop a b tmp dep = begin let r = sub tmp 0ul len in let m = sub tmp len len in - let num = b.(U32 (dep /^ 8ul)) in + let num = b.(U32.(dep /^ 8ul)) in let msk = ith_bit_mask num (U32.rem dep 8ul) in apply_mask a m msk; gf128_add r m; @@ -109,7 +109,7 @@ let rec gf128_mul_loop a b tmp dep = gf128_shift_right a; let num = a.(0ul) in a.(0ul) <- (num ^^ (logand msk r_mul)); - gf128_mul_loop a b tmp (U32 (dep +^ 1ul)) + gf128_mul_loop a b tmp (U32.(dep +^ 1ul)) end (* In place multiplication. Calculate "a * b" and store the result in a. *) @@ -146,7 +146,7 @@ private val ghash_loop_: let ghash_loop_ tag auth_key str len dep = push_frame(); let last = create 0uy 16ul in - blit str dep last 0ul (U32 (len -^ dep)); + blit str dep last 0ul (U32.(len -^ dep)); add_and_multiply tag last auth_key; pop_frame() @@ -161,9 +161,9 @@ private val ghash_loop: (ensures (fun h0 _ h1 -> live h1 tag /\ live h1 auth_key /\ live h1 str /\ modifies_1 tag h0 h1)) let rec ghash_loop tag auth_key str len dep = (* Appending zeros if the last block is not a complete one. *) - let rest = U32(len -^ dep) in + let rest = U32.(len -^ dep) in if rest <> 0ul then - if U32 (16ul >=^ rest) then ghash_loop_ tag auth_key str len dep + if U32.(16ul >=^ rest) then ghash_loop_ tag auth_key str len dep else begin let next = U32.add dep 16ul in @@ -192,7 +192,7 @@ let mk_len_info len_info len_1 len_2 = upd len_info 4ul (uint32_to_uint8 len_1); let len_1 = len_1 >>^ 8ul in upd len_info 3ul (uint32_to_uint8 len_1); - let last = FStar.UInt8 (uint32_to_uint8 len_2 <<^ 3ul) in + let last = FStar.UInt8.(uint32_to_uint8 len_2 <<^ 3ul) in upd len_info 15ul last; let len_2 = len_2 >>^ 5ul in upd len_info 14ul (uint32_to_uint8 len_2); diff --git a/examples/low-level/crypto/Crypto.Symmetric.PRF.fst b/examples/low-level/crypto/Crypto.Symmetric.PRF.fst index ac67abf1226..03b3830e4f7 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.PRF.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.PRF.fst @@ -72,7 +72,7 @@ let above #i x z = x.iv = z.iv && x.ctr >=^ z.ctr // the range of our PRF, after idealization and "reverse inlining." // for one-time-pads, we keep both the plain and cipher blocks, instead of their XOR. -type smac (rgn:region) (i:id) x = mac: MAC.state (i,x.iv) { MAC.State.region mac = rgn } +type smac (rgn:region) (i:id) x = mac: MAC.state (i,x.iv) { MAC.State?.region mac = rgn } noeq type otp (i:id) = | OTP: l:u32 {l <=^ blocklen i} -> plain i (v l) -> cipher:lbytes (v l) -> otp i let range (mac_rgn:region) (i:id) (x:domain i): Type0 = @@ -125,7 +125,7 @@ noeq type state (i:id) = #mac_rgn: region{mac_rgn `HH.extends` rgn} -> // key is immutable once generated, we should make it private key: lbuffer (v (keylen i)) - {Buffer.frameOf key = rgn /\ ~(HS.MkRef.mm (Buffer.content key))} -> + {Buffer.frameOf key = rgn /\ ~(HS.MkRef?.mm (Buffer.content key))} -> table: table_t rgn mac_rgn i -> state i @@ -204,8 +204,8 @@ val prf_mac: | Some mac' -> h0 == h1 /\ // when decrypting mac == mac' /\ - MAC (norm h1 mac.r) /\ - MAC (Buffer.live h1 mac.s) + MAC.(norm h1 mac'.r) /\ (* [MAC.mac] is defined, so shadows local definition [mac] *) + MAC.(Buffer.live h1 mac'.s) | None -> // when encrypting, we get the stateful post of MAC.create (match find_mac (HS.sel h1 r) x with | Some mac' -> @@ -236,17 +236,18 @@ let prf_mac i t x = recall r; let contents = !r in match find_mac contents x with - | Some mac -> - assume (MAC (norm h0 mac.r)); //TODO: replace this using monotonicity - assume (HS (Buffer (MAC (not ((Buffer.content mac.s).mm))))); //TODO: mark this as not manually managed - Buffer.recall (MAC mac.s); + | Some mac -> + let mac' = mac in (* [MAC.mac] is defined, so shadows locally defined [mac] *) + assume (MAC.(norm h0 mac'.r)); //TODO: replace this using monotonicity + assume (HS.(Buffer.(MAC.(not ((Buffer.content mac'.s).mm))))); //TODO: mark this as not manually managed + Buffer.recall (MAC.(mac'.s)); mac | None -> let mac = MAC.gen macId t.mac_rgn in r := SeqProperties.snoc contents (Entry x mac); assume false; //16-10-16 framing after chang eto genPost0? - //let h = ST.get() in assume(MAC(norm h mac.r)); + //let h = ST.get() in assume(MAC.(norm h mac.r)); mac end else diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bigint.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bigint.fst.hints index 594129bd9c4..a66f5cdc5e9 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bigint.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bigint.fst.hints @@ -78,8 +78,8 @@ "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.bitweight.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.bitweight.fuel_instrumented", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.bitweight.fuel_instrumented", - "int_inversion", "primitive_Prims.op_Addition", - "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.Poly1305.Bigint.bitweight", "unit_typing" ], @@ -100,12 +100,10 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Buffer.buffer", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", - "equation_FStar.UInt64.t", "equation_Prims.nat", - "equation_Prims.pos", - "fuel_correspondence_Prims.pow2.fuel_instrumented", + "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", + "equation_Prims.nat", "equation_Prims.pos", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "int_inversion", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", @@ -179,16 +177,14 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_FStar.Buffer.buffer", "equation_FStar.List.Tot.test_sort", - "equation_FStar.UInt64.t", "equation_Prims._assert", + "equation_FStar.Buffer.buffer", "equation_FStar.UInt64.t", "equation_Prims.nat", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "primitive_Prims.op_Subtraction", + "int_inversion", "primitive_Prims.op_Subtraction", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_a94026ac81c54cb83aa40ac456c322eb", "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", @@ -211,11 +207,10 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u8", "equation_FStar.Buffer.buffer", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt8.n", - "equation_FStar.UInt8.t", "equation_Prims.nat", "equation_Prims.pos", - "fuel_correspondence_Prims.pow2.fuel_instrumented", + "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_Prims.nat", "equation_Prims.pos", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "int_inversion", "int_typing", "primitive_Prims.op_Addition", @@ -227,9 +222,7 @@ "refinement_interpretation_Tm_refine_06b8b036d892ce64b891888bc5399981", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_da6fd9c5f7bf46f15d55c219e0dc0677", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "refinement_interpretation_Tm_refine_f9d0183e88a20142f8fbc6f18b9eb947", "well-founded-ordering-on-nat" ], 0 @@ -295,25 +288,28 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.idx", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperStack.contains", "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", "equation_Prims._assert", - "equation_Prims.nat", "equation_Prims.pos", + "equation_Prims.pos", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "kinding_FStar.UInt64.t_@tok", + "int_typing", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_GreaterThan", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_1a662156161cb12690985f822dcfe89c", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.Buffer.idx", "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -335,43 +331,37 @@ 2, 2, [ - "@query", "b2t_def", "binder_x_6d36f607a7b3cb43bf125269894e1f8a_1", + "@query", "binder_x_6d36f607a7b3cb43bf125269894e1f8a_1", "binder_x_cade9e2ecbd087d2a73cfbcef90133c2_0", "binder_x_f874207a254bbfbc4fab1b871c7ba22f_2", - "data_elim_FStar.UInt32.Mk", "equality_tok_Prims.LexTop@tok", + "equality_tok_Prims.LexTop@tok", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.Parameters.nlength", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.idx", - "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt.fits", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", - "equation_Prims._assert", "equation_Prims.nat", "equation_Prims.pos", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperStack.contains", + "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt64.t", + "equation_FStar.UInt64.v", "equation_Prims._assert", + "equation_Prims.nat", "equation_Prims.pos", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", - "function_token_typing_Crypto.Symmetric.Poly1305.Parameters.nlength", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "kinding_FStar.UInt64.t_@tok", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Subtraction", + "int_typing", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_Subtraction", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_11c50f93c7abcc9c3b84f1c9c4da560f", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "token_correspondence_Prims.op_LessThan", "typing_FStar.Buffer.idx", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -430,7 +420,7 @@ "equation_Prims.nat", "equation_Prims.pos", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", @@ -441,7 +431,7 @@ "refinement_interpretation_Tm_refine_7480444c36303982be3ccea8acbe04a4", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -555,7 +545,7 @@ "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.equal", "equation_FStar.Buffer.get", "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt64.t", "equation_Prims._assert", - "equation_Prims.pos", + "equation_Prims.nat", "equation_Prims.pos", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_guarded_inversion_FStar.Buffer._buffer", @@ -565,13 +555,13 @@ "int_typing", "kinding_FStar.UInt64.t_@tok", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", + "refinement_interpretation_Tm_refine_263449dccc55c4cec44518f069ac62f4", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", "refinement_interpretation_Tm_refine_8cd703db66183b198100199bf7a1fcf6", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "refinement_interpretation_Tm_refine_f77fa057dd6b01b0034cba2740aafb32", - "typing_FStar.Buffer.as_seq", "unit_inversion", "unit_typing", + "typing_FStar.Buffer.as_seq", "unit_inversion", "well-founded-ordering-on-nat" ], 0 @@ -663,7 +653,7 @@ "equation_Prims.nat", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", @@ -675,7 +665,7 @@ "refinement_interpretation_Tm_refine_8cd703db66183b198100199bf7a1fcf6", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_cfe2ba4e5a7f10a5b124a7bbbef7194e", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -704,11 +694,17 @@ 0, 1, [ - "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_FStar.UInt64.t", "equation_Prims.nat", "int_inversion", - "primitive_Prims.op_Addition", "primitive_Prims.op_Subtraction", - "projection_inverse_BoxInt_proj_0", + "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", + "equation_Crypto.Symmetric.Poly1305.Bigint.u64", + "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", + "equation_FStar.Buffer.buffer", "equation_FStar.UInt64.t", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_1c90d41677d8d12848b1c3bbc2fc0576", + "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", + "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d" ], 0 @@ -730,33 +726,28 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_FStar.Buffer.bounded_seq", "equation_FStar.Buffer.buffer", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", - "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", - "equation_Prims._assert", "equation_Prims.nat", + "equation_FStar.UInt64.t", "equation_Prims._assert", + "equation_Prims.nat", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "kinding_FStar.UInt64.t_@tok", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_11a8c31aa71fcb1b521ce0e675d638ca", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", - "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", "refinement_interpretation_Tm_refine_8cd703db66183b198100199bf7a1fcf6", - "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_FStar.Buffer.get", "typing_FStar.UInt64.v", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ], @@ -804,7 +795,7 @@ "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", @@ -815,7 +806,10 @@ "refinement_interpretation_Tm_refine_11c50f93c7abcc9c3b84f1c9c4da560f", "refinement_interpretation_Tm_refine_2948e226655aed2a16d340706d9f751b", "refinement_interpretation_Tm_refine_652c6713c771075085c556101f5aa439", + "refinement_interpretation_Tm_refine_a94026ac81c54cb83aa40ac456c322eb", + "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.Poly1305.Bigint.eval", "unit_inversion", "well-founded-ordering-on-nat" ], 0 @@ -848,7 +842,7 @@ "equation_Prims.nat", "equation_Prims.pos", "equation_with_fuel_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "fuel_correspondence_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_irrelevance_Crypto.Symmetric.Poly1305.Bigint.maxValue.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", @@ -858,9 +852,8 @@ "refinement_interpretation_Tm_refine_232dc8c72b31fc03db0587f17f83bfd5", "refinement_interpretation_Tm_refine_7480444c36303982be3ccea8acbe04a4", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_cb2bc236e1ee2b35049db79ebc26f886", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "well-founded-ordering-on-nat" + "unit_inversion", "well-founded-ordering-on-nat" ], 0 ] diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.fst.hints index 69e9415e96e..26d444e195f 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.fst.hints @@ -4,7 +4,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.prime", 1, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int", @@ -37,7 +37,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.willNotOverflow", 1, - 2, + 0, 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", @@ -51,7 +51,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 1, - 2, + 0, 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", @@ -65,7 +65,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 2, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -73,7 +73,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 3, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -81,7 +81,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 4, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -89,7 +89,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 5, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -97,7 +97,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", 6, - 2, + 0, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -105,7 +105,7 @@ [ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.bound27", 1, - 2, + 0, 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", @@ -130,12 +130,9 @@ 0, 1, [ - "@query", "equation_FStar.List.Tot.test_sort", - "equation_FStar.UInt64.v", "equation_Prims._assert", + "@query", "equation_FStar.UInt64.v", "fuel_correspondence_Prims.pow2.fuel_instrumented", - "function_token_typing_FStar.List.Tot.test_sort", - "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", - "unit_inversion" + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0" ], 0 ], @@ -234,11 +231,8 @@ 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Parameters.templ", - "equation_FStar.List.Tot.test_sort", "equation_Prims._assert", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "unit_inversion" + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" ], 0 ], @@ -271,7 +265,6 @@ 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", - "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Mul.op_Star", "equation_FStar.UInt64.t", @@ -283,10 +276,7 @@ "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_a94026ac81c54cb83aa40ac456c322eb", - "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.Poly1305.Bigint.eval" + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d" ], 0 ], @@ -335,7 +325,7 @@ "refinement_interpretation_Tm_refine_a94026ac81c54cb83aa40ac456c322eb", "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.Poly1305.Bigint.eval" + "token_correspondence_Crypto.Symmetric.Poly1305.Bigint.eval.fuel_instrumented" ], 0 ], @@ -370,7 +360,6 @@ 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", - "equation_Crypto.Symmetric.Poly1305.Bigint.heap", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Mul.op_Star", "equation_FStar.UInt64.t", @@ -382,10 +371,7 @@ "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_a94026ac81c54cb83aa40ac456c322eb", - "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_Crypto.Symmetric.Poly1305.Bigint.eval" + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d" ], 0 ], @@ -406,7 +392,7 @@ "@query", "equation_FStar.Mul.op_Star", "int_inversion", "int_typing", "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", - "unit_inversion" + "unit_typing" ], 0 ], @@ -425,6 +411,7 @@ 1, [ "@query", + "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.bound27", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "projection_inverse_BoxInt_proj_0" @@ -444,25 +431,27 @@ "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isSum", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Parameters.templ", - "equation_FStar.Buffer.buffer", "equation_FStar.List.Tot.test_sort", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", - "equation_FStar.UInt64.v", "equation_Prims._assert", + "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.get", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", + "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", - "fuel_guarded_inversion_FStar.HyperStack.mem", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", + "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", "int_inversion", "int_typing", "kinding_FStar.UInt64.t_@tok", "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.Buffer.get", "typing_FStar.UInt64.v", - "typing_Prims.pow2", "unit_inversion" + "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.get", + "typing_FStar.Seq.index", "typing_FStar.UInt64.__proj__Mk__item__v", + "typing_FStar.UInt64.v", "typing_Prims.pow2" ], 0 ], @@ -656,14 +645,12 @@ 0, 1, [ - "@query", "b2t_def", "equation_FStar.List.Tot.test_sort", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", - "equation_FStar.UInt64.v", "equation_Prims._assert", + "@query", "b2t_def", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt64.n", "equation_FStar.UInt64.v", "equation_Prims.nat", "equation_Prims.pos", - "fuel_correspondence_Prims.pow2.fuel_instrumented", - "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", + "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", "int_typing", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "projection_inverse_BoxBool_proj_0", @@ -671,7 +658,8 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.UInt64.v", "typing_Prims.pow2", "unit_inversion" + "token_correspondence_Prims.pow2.fuel_instrumented", + "typing_FStar.UInt64.v", "typing_Prims.pow2" ], 0 ], @@ -730,8 +718,8 @@ "@query", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_Prims._assert", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0" + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0" ], 0 ], @@ -820,8 +808,8 @@ "@query", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_Prims._assert", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", - "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", - "projection_inverse_BoxInt_proj_0" + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0" ], 0 ], diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part2.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part2.fst.hints index 5b66b0bfa61..f7b2b127c26 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part2.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part2.fst.hints @@ -5,15 +5,14 @@ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part2.lemma_multiplication060", 1, 0, - 2, + 1, [ "@query", "equation_FStar.List.Tot.test_sort", "equation_FStar.Mul.op_Star", "equation_Prims._assert", "fuel_correspondence_Prims.pow2.fuel_instrumented", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "projection_inverse_BoxInt_proj_0" + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0" ], 0 ], @@ -359,16 +358,12 @@ "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isMultiplication", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Parameters.templ", - "equation_FStar.Buffer.buffer", "equation_FStar.Int8.n", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", - "equation_Prims.nat", "equation_Prims.pos", - "fuel_guarded_inversion_FStar.Buffer.buffer_", - "fuel_guarded_inversion_FStar.HyperStack.mem", - "function_token_typing_FStar.Int8.n", "int_inversion", "int_typing", - "kinding_FStar.UInt64.t_@tok", "primitive_Prims.op_Addition", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxBool_proj_0", @@ -376,11 +371,9 @@ "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_160771b25134b8980d8dbd379f76ee2f", - "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.Buffer.get", "typing_FStar.UInt64.v" + "typing_Prims.pow2" ], 0 ], @@ -399,13 +392,12 @@ 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", - "equation_Crypto.Symmetric.Poly1305.Bigint.norm", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.bound27", + "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.isMultiplication", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Buffer.buffer", "equation_FStar.Mul.op_Star", "equation_FStar.UInt64.t", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", @@ -424,8 +416,7 @@ "@query", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Mul.op_Star", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "unit_inversion", "unit_typing" + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" ], 0 ] diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.fst.hints index 306ba0054b4..004662eb3f5 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.fst.hints @@ -5,7 +5,7 @@ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.isCarried", 1, 0, - 2, + 1, [ "@query", "b2t_def", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", @@ -14,14 +14,13 @@ "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", - "equation_Prims.nat", "equation_Prims.pos", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 @@ -95,15 +94,17 @@ "equation_FStar.UInt.fits", "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", - "equation_FStar.UInt64.v", "equation_Prims.pos", - "fuel_guarded_inversion_FStar.UInt64.t_", "int_inversion", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "equation_FStar.UInt64.v", "equation_Prims.nat", + "equation_Prims.pos", "fuel_guarded_inversion_FStar.UInt64.t_", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "proj_equation_FStar.UInt64.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 @@ -223,8 +224,9 @@ 0, 1, [ - "@query", "primitive_Prims.op_Subtraction", - "projection_inverse_BoxInt_proj_0" + "@query", "equation_Prims.pos", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 ], @@ -462,11 +464,10 @@ 0, 1, [ - "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", + "@query", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], @@ -650,11 +651,10 @@ 0, 1, [ - "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", + "@query", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], @@ -905,7 +905,6 @@ 1, [ "@query", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part3.bound63", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.isCarried", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0" @@ -946,7 +945,7 @@ "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Buffer.buffer", "equation_FStar.UInt64.t", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f" @@ -980,26 +979,16 @@ 0, 1, [ - "@query", "b2t_def", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.Poly1305.Parameters.nlength", - "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", - "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_Prims.nat", + "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", "equation_Prims.pos", - "fuel_correspondence_Prims.pow2.fuel_instrumented", - "function_token_typing_Crypto.Symmetric.Poly1305.Parameters.nlength", - "int_inversion", "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", - "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", - "projection_inverse_BoxBool_proj_0", + "fuel_correspondence_Prims.pow2.fuel_instrumented", "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_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_2fd2ca5ba5888b39b1231badbe38fb2e", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Prims.pow2", "unit_inversion" + "typing_Prims.pow2" ], 0 ], @@ -1041,7 +1030,7 @@ "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_99d212c0335bce88ec32beb431e6360c", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Prims.pow2", "unit_inversion", "unit_typing" + "typing_Prims.pow2" ], 0 ], @@ -1075,7 +1064,8 @@ "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.isCarried", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Parameters.templ", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", + "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.get", "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.Int16.n", "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt.fits", @@ -1085,6 +1075,7 @@ "equation_Prims._assert", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.UInt64.t_", "function_token_typing_FStar.Int16.n", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", "int_typing", "kinding_FStar.UInt64.t_@tok", @@ -1092,16 +1083,19 @@ "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Division", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", + "proj_equation_FStar.UInt64.Mk_v", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", "refinement_interpretation_Tm_refine_8db9a1f0b2e30457a59f15ea5538383e", - "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.Buffer.get", "typing_FStar.UInt64.v" + "typing_FStar.Buffer.as_seq", "typing_FStar.Seq.index", + "typing_FStar.UInt64.__proj__Mk__item__v", "typing_Prims.pow2" ], 0 ], @@ -1179,7 +1173,6 @@ 1, [ "@query", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.carried_2", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.isCarried", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0" diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.fst.hints index 9d1c5e55048..8fb2ed47119 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.fst.hints @@ -88,7 +88,7 @@ "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "int_typing", "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", @@ -223,7 +223,7 @@ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.prime", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.carried_1", + "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.carried_2", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carriedTopBottom", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Spec.p_1305", @@ -272,22 +272,25 @@ "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carried_4", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Parameters.templ", - "equation_FStar.Buffer.buffer", "equation_FStar.Mul.op_Star", + "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.get", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.uint_t", "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", "equation_Prims.nat", "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_FStar.Buffer.buffer_", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "int_inversion", "int_typing", "kinding_FStar.UInt64.t_@tok", "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_b0cc669109f5223394a5a92793efa434", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "typing_FStar.Buffer.get", "typing_FStar.UInt64.v", "unit_typing" + "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", + "typing_FStar.Buffer.as_seq", "typing_FStar.Seq.index", + "typing_FStar.UInt64.__proj__Mk__item__v", "unit_typing" ], 0 ], @@ -308,7 +311,6 @@ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part1.prime", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part4.carried_3", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carriedTopBottom", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_Crypto.Symmetric.Poly1305.Spec.p_1305", @@ -435,7 +437,7 @@ "Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.lemma_norm_5", 1, 0, - 2, + 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.norm", @@ -444,7 +446,7 @@ "equation_Crypto.Symmetric.Poly1305.Parameters.templ", "equation_FStar.Buffer.buffer", "equation_FStar.List.Tot.test_sort", "equation_FStar.UInt64.t", "equation_Prims._assert", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "function_token_typing_FStar.List.Tot.test_sort", "int_inversion", "projection_inverse_BoxInt_proj_0", @@ -465,8 +467,7 @@ "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carried_4", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.isCarried01", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_FStar.Buffer.bounded_seq", - "equation_FStar.Buffer.contains", "equation_FStar.Buffer.idx", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.live", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperStack.contains", "equation_FStar.UInt.fits", @@ -475,24 +476,19 @@ "equation_FStar.UInt64.t", "equation_FStar.UInt64.v", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", + "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "int_typing", - "kinding_FStar.UInt64.t_@tok", "lemma_FStar.Int.pow2_values", - "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", - "primitive_Prims.op_Equality", + "lemma_FStar.Int.pow2_values", "primitive_Prims.op_Addition", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", "primitive_Prims.op_GreaterThanOrEqual", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", - "proj_equation_FStar.Buffer.Mkbuffer__content", - "proj_equation_FStar.HyperStack.HS_h", - "proj_equation_FStar.HyperStack.MkRef_id", - "proj_equation_FStar.HyperStack.MkRef_ref", "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_FStar.Buffer.idx" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 ], @@ -523,7 +519,6 @@ [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carried_4", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.isCarried01", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.UInt64.t", "projection_inverse_BoxInt_proj_0", @@ -540,7 +535,6 @@ "@query", "b2t_def", "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carried_4", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.isCarried01", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", @@ -602,7 +596,6 @@ 1, [ "@query", "equation_Crypto.Symmetric.Poly1305.Bigint.norm", - "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.carried_4", "equation_Crypto.Symmetric.Poly1305.Bignum.Lemmas.Part5.isCarried01", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", "projection_inverse_BoxInt_proj_0" diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.fst b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.fst index 97e32a31ddb..0056bb3291a 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Bignum.fst @@ -454,8 +454,8 @@ val finalize: b:bigint -> Stack unit (ensures (fun h0 _ h1 -> norm h0 b /\ norm h1 b /\ modifies_1 b h0 h1 /\ eval h1 b norm_length = eval h0 b norm_length % reveal prime)) let finalize b = - let mask_26 = U64 ((1uL <<^ 26ul) -^ 1uL) in - let mask2_26m5 = U64 (mask_26 -^ (1uL <<^ 2ul)) in + let mask_26 = U64.((1uL <<^ 26ul) -^ 1uL) in + let mask2_26m5 = U64.(mask_26 -^ (1uL <<^ 2ul)) in let b0 = b.(0ul) in let b1 = b.(1ul) in let b2 = b.(2ul) in diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst index 8df50de9a0e..30d19d69a6a 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst @@ -307,10 +307,10 @@ let update #i st l a v = (* type invoked (#i:id) (st:state i) (m:mem) : Type = - mac_log /\ is_Some (sel m (State.log st)) + mac_log /\ Some? (sel m (State.log st)) val mac: #i:id -> st:state i -> m:msg -> buf:buffer{lbytes 16} -> ST tag - (requires (fun m0 -> is_None (m_sel m0 st.log))) + (requires (fun m0 -> None? (m_sel m0 st.log))) (ensures (fun m0 tag m1 -> modifies (Set.singleton (State.rid st)) m0 m1 /\ modifies_rref st.rid !{HH.as_ref (as_rref st.log)} m0.h m1.h diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst.hints b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst.hints index 8db74fcbbe1..e94d7f05f2a 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst.hints +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.MAC.fst.hints @@ -34,7 +34,7 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v", - "typing_Flag.Mkid.cipher" + "typing_Flag.__proj__Mkid__item__cipher" ], 0 ], @@ -68,7 +68,7 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", - "typing_Flag.Mkid.cipher" + "typing_Flag.__proj__Mkid__item__cipher" ], 0 ], @@ -214,7 +214,7 @@ 1, [ "@query", "constructor_distinct_Prims.Mktuple2", - "data_elim_Prims.Some", "eq2-interp", + "data_elim_Prims.None", "data_elim_Prims.Some", "eq2-interp", "equation_Crypto.Symmetric.Poly1305.MAC.itext", "equation_Crypto.Symmetric.Poly1305.MAC.log", "equation_Crypto.Symmetric.Poly1305.MAC.log_cmp", @@ -244,7 +244,6 @@ "equation_Crypto.Symmetric.Poly1305.Spec.tag", "equation_Crypto.Symmetric.Poly1305.Spec.word_16", "equation_FStar.Monotonic.RRef.monotonic", "false_interp", - "fuel_guarded_inversion_Prims.option", "fuel_guarded_inversion_Prims.tuple2", "l_and-interp", "lemma_Crypto.Symmetric.Poly1305.MAC.log_cmp_reflexive", "projection_inverse_Prims.Mktuple2__1", @@ -252,21 +251,11 @@ "projection_inverse_Prims.Mktuple2__a", "projection_inverse_Prims.Mktuple2__b", "token_correspondence_Crypto.Symmetric.Poly1305.MAC.log_cmp", - "true_interp", "unit_typing" - ], - 0 - ], - [ - "Crypto.Symmetric.Poly1305.MAC.log_ref", - 1, - 0, - 1, - [ - "@query", "equation_Prims._assert", - "pretyping_f8666440faa91836cc5a13998af863fc", "unit_typing" + "unit_typing" ], 0 ], + [ "Crypto.Symmetric.Poly1305.MAC.log_ref", 1, 0, 1, [ "@query" ], 0 ], [ "Crypto.Symmetric.Poly1305.MAC.ilog", 1, @@ -314,7 +303,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.region", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__region", 1, 0, 1, @@ -322,7 +311,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.r", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__r", 1, 0, 1, @@ -330,7 +319,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.r", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__r", 2, 0, 1, @@ -345,7 +334,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.s", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__s", 1, 0, 1, @@ -353,7 +342,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.s", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__s", 2, 0, 1, @@ -369,7 +358,7 @@ 0 ], [ - "Crypto.Symmetric.Poly1305.MAC.State.log", + "Crypto.Symmetric.Poly1305.MAC.__proj__State__item__log", 1, 0, 1, @@ -389,12 +378,19 @@ [ "@query", "assumption_FStar.HyperHeap.HasEq_rid" ], 0 ], - [ "Crypto.Symmetric.Poly1305.MAC.alloc", 1, 0, 1, [ "@query" ], 0 ], [ "Crypto.Symmetric.Poly1305.MAC.alloc", - 2, + 1, 0, + 1, + [ "@query", "projection_inverse_BoxInt_proj_0" ], + 0 + ], + [ + "Crypto.Symmetric.Poly1305.MAC.alloc", 2, + 0, + 1, [ "@query", "assumption_FStar.Heap.DomConcat", "assumption_FStar.Heap.DomContains", @@ -430,17 +426,18 @@ "equation_Crypto.Symmetric.Poly1305.MAC.norm", "equation_Crypto.Symmetric.Poly1305.Parameters.nlength", "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", + "equation_Crypto.Symmetric.Poly1305.Parameters.templ", "equation_Crypto.Symmetric.Poly1305.Spec.tag", "equation_Crypto.Symmetric.Poly1305.Spec.word_16", "equation_Crypto.Symmetric.Poly1305.log_t", "equation_FStar.Buffer.as_aref", "equation_FStar.Buffer.as_ref", "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", "equation_FStar.Buffer.content", - "equation_FStar.Buffer.disjoint", "equation_FStar.Buffer.frameOf", - "equation_FStar.Buffer.get", "equation_FStar.Buffer.idx", - "equation_FStar.Buffer.length", "equation_FStar.Buffer.live", - "equation_FStar.Buffer.modifies_buf_2", "equation_FStar.Buffer.sel", - "equation_FStar.Heap.modifies", + "equation_FStar.Buffer.disjoint", "equation_FStar.Buffer.equal", + "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.get", + "equation_FStar.Buffer.idx", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", "equation_FStar.Buffer.modifies_buf_2", + "equation_FStar.Buffer.sel", "equation_FStar.Heap.modifies", "equation_FStar.HyperHeap.contains_ref", "equation_FStar.HyperHeap.map_invariant", "equation_FStar.HyperHeap.modifies_just", @@ -501,7 +498,6 @@ "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", - "function_token_typing_FStar.HyperHeap.root", "function_token_typing_FStar.List.Tot.test_sort", "function_token_typing_FStar.UInt64.n", "function_token_typing_FStar.UInt8.n", @@ -510,6 +506,7 @@ "kinding_FStar.UInt8.t_@tok", "kinding_Prims.tuple2@tok", "l_and-interp", "l_not-interp", "l_or-interp", "lemma_Crypto.Symmetric.Poly1305.MAC.log_cmp_reflexive", + "lemma_FStar.Buffer.Quantifiers.lemma_create_quantifiers", "lemma_FStar.Buffer.lemma_disjoint_symm", "lemma_FStar.Buffer.lemma_live_disjoint", "lemma_FStar.HyperHeap.lemma_as_ref_inj", @@ -536,7 +533,6 @@ "lemma_FStar.TSet.mem_subset", "lemma_FStar.TSet.mem_union", "pretyping_24fcca413a49c3b9891a433ace204782", "pretyping_6c86c071b92797cdf01eb016249a9465", - "pretyping_9248629b80e5ece8a5830df634103252", "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", @@ -580,36 +576,38 @@ "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", "refinement_interpretation_Tm_refine_e0347f438a5eb94484943d30b66e67fe", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9be3e34b8974cf7d211692dbf125969", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "refinement_interpretation_Tm_refine_f3541dc4dd2e5cd1d49dfd99af20aa66", - "refinement_kinding_Tm_refine_c80f93641670351ef037bee53d1c4edc", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", + "refinement_kinding_Tm_refine_8e561ff83f56135ffaf292b237824306", "token_correspondence_Crypto.Symmetric.Poly1305.MAC.log_cmp", - "true_interp", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.content", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.Buffer.as_aref", - "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.frameOf", - "typing_FStar.Buffer.idx", "typing_FStar.Buffer.length", - "typing_FStar.Buffer.sel", "typing_FStar.Heap.concat", - "typing_FStar.Heap.contains", "typing_FStar.Heap.domain", - "typing_FStar.Heap.restrict", "typing_FStar.Heap.upd", - "typing_FStar.HyperHeap.as_ref", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.as_aref", "typing_FStar.Buffer.as_seq", + "typing_FStar.Buffer.frameOf", "typing_FStar.Buffer.idx", + "typing_FStar.Buffer.length", "typing_FStar.Buffer.sel", + "typing_FStar.Heap.concat", "typing_FStar.Heap.contains", + "typing_FStar.Heap.domain", "typing_FStar.Heap.restrict", + "typing_FStar.Heap.upd", "typing_FStar.HyperHeap.as_ref", "typing_FStar.HyperHeap.contains_ref", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.MkRef.id", - "typing_FStar.HyperStack.MkRef.mm", - "typing_FStar.HyperStack.MkRef.ref", - "typing_FStar.HyperStack.is_above", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.__proj__MkRef__item__mm", + "typing_FStar.HyperStack.__proj__MkRef__item__ref", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.HyperStack.is_in", "typing_FStar.HyperStack.sel", "typing_FStar.Map.concat", "typing_FStar.Map.contains", "typing_FStar.Map.domain", "typing_FStar.Map.restrict", - "typing_FStar.Map.sel", "typing_FStar.Monotonic.RRef.as_hsref", + "typing_FStar.Map.sel", "typing_FStar.Map.upd", + "typing_FStar.Monotonic.RRef.as_hsref", "typing_FStar.Set.complement", "typing_FStar.Set.mem", "typing_FStar.Set.singleton", "typing_FStar.Set.union", "typing_FStar.TSet.complement", "typing_FStar.TSet.empty", @@ -682,15 +680,15 @@ "equation_FStar.Monotonic.RRef.m_contains", "equation_FStar.Monotonic.RRef.reln", "equation_FStar.Monotonic.RRef.rid", "equation_FStar.Mul.op_Star", - "equation_FStar.TSet.subset", "equation_FStar.UInt.fits", - "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", - "equation_FStar.UInt.mul", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", - "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", - "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", - "equation_FStar.UInt64.t", "equation_FStar.UInt8.n", - "equation_FStar.UInt8.t", "equation_Prims.eqtype", - "equation_Prims.nat", "equation_Prims.pos", + "equation_FStar.Set.subset", "equation_FStar.TSet.subset", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt64.t", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_Prims.eqtype", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "fuel_guarded_inversion_Crypto.Symmetric.Poly1305.MAC.state", "fuel_guarded_inversion_FStar.Buffer._buffer", @@ -745,26 +743,27 @@ "refinement_interpretation_Tm_refine_2e27886803aa0fd3d56845dfd9c07c4a", "refinement_interpretation_Tm_refine_3201164f3fd34668bc5e4add1cefd491", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_44b47540f967ebd7b9d4b2a90dbab172", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c511d7e559ebbc66a27408da951ecc50", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "refinement_interpretation_Tm_refine_e9be3e34b8974cf7d211692dbf125969", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "refinement_interpretation_Tm_refine_f3541dc4dd2e5cd1d49dfd99af20aa66", - "refinement_interpretation_Tm_refine_fec2f0b77e6a261e4db626ed66e17e53", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "refinement_kinding_Tm_refine_474997e55e54e0875d3f887cd7682241", "typing_Crypto.Symmetric.AES.v", - "typing_Crypto.Symmetric.Poly1305.MAC.State.log", - "typing_Crypto.Symmetric.Poly1305.MAC.State.r", - "typing_Crypto.Symmetric.Poly1305.MAC.State.s", - "typing_FStar.Buffer.MkBuffer.content", "typing_FStar.Buffer.as_ref", - "typing_FStar.Buffer.content", "typing_FStar.Buffer.frameOf", - "typing_FStar.Heap.concat", "typing_FStar.Heap.contains", - "typing_FStar.Heap.domain", "typing_FStar.Heap.restrict", - "typing_FStar.HyperHeap.as_ref", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.MkRef.ref", + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__log", + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__r", + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__s", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.as_ref", "typing_FStar.Buffer.content", + "typing_FStar.Buffer.frameOf", "typing_FStar.Heap.concat", + "typing_FStar.Heap.contains", "typing_FStar.Heap.domain", + "typing_FStar.Heap.restrict", "typing_FStar.HyperHeap.as_ref", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__MkRef__item__ref", "typing_FStar.HyperStack.is_eternal_region", "typing_FStar.Map.concat", "typing_FStar.Map.contains", "typing_FStar.Map.domain", "typing_FStar.Map.restrict", @@ -801,8 +800,22 @@ 0 ], [ "Crypto.Symmetric.Poly1305.MAC.irtext", 1, 0, 1, [ "@query" ], 0 ], - [ "Crypto.Symmetric.Poly1305.MAC.Acc.l", 1, 0, 1, [ "@query" ], 0 ], - [ "Crypto.Symmetric.Poly1305.MAC.Acc.a", 1, 0, 1, [ "@query" ], 0 ], + [ + "Crypto.Symmetric.Poly1305.MAC.__proj__Acc__item__l", + 1, + 0, + 1, + [ "@query" ], + 0 + ], + [ + "Crypto.Symmetric.Poly1305.MAC.__proj__Acc__item__a", + 1, + 0, + 1, + [ "@query" ], + 0 + ], [ "Crypto.Symmetric.Poly1305.MAC.alog", 1, @@ -813,7 +826,7 @@ "equation_Crypto.Symmetric.Poly1305.MAC.irtext", "function_token_typing_Flag.mac_log", "refinement_interpretation_Tm_refine_292f709249fa05c420a48007f2497271", - "typing_Crypto.Symmetric.Poly1305.MAC.Acc.l" + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__Acc__item__l" ], 0 ], @@ -836,81 +849,7 @@ ], 0 ], - [ - "Crypto.Symmetric.Poly1305.MAC.start", - 1, - 2, - 2, - [ - "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", - "bool_inversion", "data_elim_FStar.UInt32.Mk", - "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", - "equation_Crypto.Symmetric.Poly1305.Bigint.norm", - "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.MAC.accB", - "equation_Crypto.Symmetric.Poly1305.MAC.acc_inv", - "equation_Crypto.Symmetric.Poly1305.MAC.norm", - "equation_Crypto.Symmetric.Poly1305.MAC.text_0", - "equation_Crypto.Symmetric.Poly1305.Parameters.nlength", - "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_Crypto.Symmetric.Poly1305.Spec.elem", - "equation_Crypto.Symmetric.Poly1305.elemB", - "equation_Crypto.Symmetric.Poly1305.sel_elem", - "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.equal", - "equation_FStar.HST.inline_stack_inv", "equation_FStar.HyperHeap.t", - "equation_FStar.HyperStack.equal_domains", - "equation_FStar.HyperStack.hh", - "equation_FStar.HyperStack.is_stack_region", - "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", - "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", - "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", - "equation_FStar.UInt64.n", "equation_FStar.UInt64.t", - "equation_Prims.eqtype", "equation_Prims.nat", "equation_Prims.pos", - "equation_with_fuel_Crypto.Symmetric.Poly1305.Spec.poly.fuel_instrumented", - "fuel_correspondence_Crypto.Symmetric.Poly1305.Spec.poly.fuel_instrumented", - "fuel_correspondence_Prims.pow2.fuel_instrumented", - "fuel_guarded_inversion_Crypto.Symmetric.Poly1305.MAC.state", - "fuel_guarded_inversion_FStar.Buffer.buffer_", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.ideal", - "function_token_typing_Crypto.Symmetric.Poly1305.Parameters.nlength", - "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", - "function_token_typing_FStar.Heap.emp", - "function_token_typing_FStar.Heap.heap", - "function_token_typing_FStar.HyperHeap.rid", - "function_token_typing_FStar.UInt64.n", "int_typing", - "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt64.t_@tok", - "lemma_FStar.Buffer.lemma_live_disjoint", - "lemma_FStar.Buffer.lemma_modifies_0_1_", - "lemma_FStar.Buffer.no_upd_lemma_0", - "lemma_FStar.Map.lemma_ContainsDom", - "lemma_FStar.Set.lemma_equal_elim", - "lemma_FStar.TSet.lemma_equal_elim", - "pretyping_6c86c071b92797cdf01eb016249a9465", - "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", - "primitive_Prims.op_GreaterThan", - "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Subtraction", - "proj_equation_Crypto.Symmetric.Poly1305.MAC.State_r", - "proj_equation_FStar.HyperStack.HS_h", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", - "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", - "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Crypto.Symmetric.Poly1305.MAC.State.r", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.Map.contains", "typing_FStar.Map.domain", - "typing_FStar.Map.sel", "typing_FStar.Seq.createEmpty", - "typing_FStar.UInt32.uint_to_t", "typing_Prims.pow2" - ], - 0 - ], + [ "Crypto.Symmetric.Poly1305.MAC.start", 1, 0, 1, [ "@query" ], 0 ], [ "Crypto.Symmetric.Poly1305.MAC.start", 2, @@ -977,83 +916,23 @@ "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", - "refinement_interpretation_Tm_refine_a57e6988f2d29bd5aa0679db10f4f337", + "refinement_interpretation_Tm_refine_44b47540f967ebd7b9d4b2a90dbab172", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c511d7e559ebbc66a27408da951ecc50", "refinement_interpretation_Tm_refine_d293195290016bcf1c5005732c49b7d3", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "refinement_interpretation_Tm_refine_fec2f0b77e6a261e4db626ed66e17e53", - "typing_Crypto.Symmetric.Poly1305.MAC.State.r", - "typing_FStar.Buffer.MkBuffer.length", "typing_FStar.Heap.domain", - "typing_FStar.HyperStack.HS.h", "typing_FStar.Map.contains", - "typing_FStar.Map.domain", "typing_FStar.Map.sel", - "typing_FStar.Seq.createEmpty", "typing_Prims.pow2" - ], - 0 - ], - [ - "Crypto.Symmetric.Poly1305.MAC.update", - 1, - 1, - 2, - [ - "@query", "bool_inversion", - "equation_Crypto.Symmetric.Poly1305.Bigint.bigint", - "equation_Crypto.Symmetric.Poly1305.Bigint.norm", - "equation_Crypto.Symmetric.Poly1305.Bigint.u64", - "equation_Crypto.Symmetric.Poly1305.MAC.accB", - "equation_Crypto.Symmetric.Poly1305.MAC.acc_inv", - "equation_Crypto.Symmetric.Poly1305.MAC.itext", - "equation_Crypto.Symmetric.Poly1305.MAC.norm", - "equation_Crypto.Symmetric.Poly1305.MAC.text_0", - "equation_Crypto.Symmetric.Poly1305.Parameters.norm_length", - "equation_Crypto.Symmetric.Poly1305.Spec.elem", - "equation_Crypto.Symmetric.Poly1305.Spec.text", - "equation_Crypto.Symmetric.Poly1305.elemB", - "equation_Crypto.Symmetric.Poly1305.sel_elem", - "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.equal", - "equation_FStar.Buffer.get", "equation_FStar.HyperHeap.t", - "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_in", - "equation_FStar.List.Tot.test_sort", - "equation_FStar.SeqProperties.snoc", "equation_FStar.UInt64.t", - "equation_Prims._assert", "equation_Prims.nat", - "equation_with_fuel_Crypto.Symmetric.Poly1305.Spec.poly.fuel_instrumented", - "fuel_correspondence_Crypto.Symmetric.Poly1305.Spec.poly.fuel_instrumented", - "fuel_guarded_inversion_Crypto.Symmetric.Poly1305.MAC.state", - "fuel_guarded_inversion_FStar.Buffer.buffer_", - "fuel_irrelevance_Crypto.Symmetric.Poly1305.Spec.poly.fuel_instrumented", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.ideal", - "function_token_typing_Crypto.Symmetric.Poly1305.MAC.text_0", - "function_token_typing_Crypto.Symmetric.Poly1305.Spec.elem", - "function_token_typing_FStar.Heap.emp", - "function_token_typing_FStar.HyperHeap.root", - "function_token_typing_FStar.List.Tot.test_sort", "int_typing", - "kinding_FStar.UInt64.t_@tok", - "lemma_FStar.Buffer.lemma_disjoint_symm", - "lemma_FStar.Buffer.no_upd_lemma_1", - "lemma_FStar.Seq.lemma_create_len", - "lemma_FStar.Seq.lemma_index_create", - "lemma_FStar.Seq.lemma_len_append", - "pretyping_6c86c071b92797cdf01eb016249a9465", - "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", - "primitive_Prims.op_Subtraction", - "proj_equation_Crypto.Symmetric.Poly1305.MAC.State_r", - "proj_equation_FStar.HyperStack.HS_h", - "projection_inverse_BoxBool_proj_0", - "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_033585b16f9282fb8c7c71161354496f", - "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", - "refinement_interpretation_Tm_refine_2b2c9f52c1489409cf3006c5c179420f", - "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", - "typing_Crypto.Symmetric.Poly1305.MAC.State.r", - "typing_Crypto.Symmetric.Poly1305.sel_elem", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.is_in", - "typing_FStar.Seq.length" + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__r", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.contains", "typing_FStar.Map.domain", + "typing_FStar.Map.sel", "typing_FStar.Seq.createEmpty", + "typing_Prims.pow2" ], 0 ], + [ "Crypto.Symmetric.Poly1305.MAC.update", 1, 0, 1, [ "@query" ], 0 ], [ "Crypto.Symmetric.Poly1305.MAC.sel_elemT", 1, 0, 1, [ "@query" ], 0 ], [ "Crypto.Symmetric.Poly1305.MAC.seq_head_snoc", @@ -1069,24 +948,37 @@ 0, 1, [ - "@query", "assumption_Crypto.Symmetric.Poly1305.Bignum.MaxUint32", + "@query", "b2t_def", "bool_inversion", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_Crypto.Symmetric.Poly1305.Spec.seq_head", - "equation_FStar.SeqProperties.snoc", "equation_Prims.nat", - "int_inversion", "int_typing", "lemma_FStar.Seq.lemma_create_len", + "equation_FStar.Mul.op_Star", "equation_FStar.SeqProperties.snoc", + "equation_FStar.UInt.fits", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_Prims.nat", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", "int_inversion", + "int_typing", "lemma_FStar.Seq.lemma_create_len", "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.Seq.lemma_index_app1", "lemma_FStar.Seq.lemma_index_slice", "lemma_FStar.Seq.lemma_len_slice", "primitive_Prims.op_Addition", - "primitive_Prims.op_LessThanOrEqual", - "primitive_Prims.op_Subtraction", - "projection_inverse_BoxBool_proj_0", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "proj_equation_FStar.UInt32.Mk_v", "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_59c2fe8e318b842f8bea3c3c4df9f3b1", "refinement_interpretation_Tm_refine_5ec5b64a8a200c47ed44dad76f0de705", "refinement_interpretation_Tm_refine_69ac71507082c44a1c7bcbc49088e702", "refinement_interpretation_Tm_refine_9d67d51cc95f7cd6f4b036168d71bd8b", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c90e16742d2e633e32c657b87c3493b3", - "typing_FStar.Seq.append", "typing_FStar.Seq.length" + "typing_Crypto.Symmetric.AES.v", "typing_FStar.Seq.append", + "typing_FStar.Seq.length", "typing_FStar.UInt.fits" ], 0 ], @@ -1096,7 +988,7 @@ 1, 1, [ - "@query", "bool_inversion", + "@query", "bool_inversion", "equation_Crypto.Symmetric.Bytes.mem", "equation_Crypto.Symmetric.Poly1305.Bigint.norm", "equation_Crypto.Symmetric.Poly1305.Bigint.u64", "equation_Crypto.Symmetric.Poly1305.MAC.accB", @@ -1140,14 +1032,15 @@ "projection_inverse_BoxBool_proj_0", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", - "refinement_interpretation_Tm_refine_2b2c9f52c1489409cf3006c5c179420f", + "refinement_interpretation_Tm_refine_44b47540f967ebd7b9d4b2a90dbab172", + "refinement_interpretation_Tm_refine_b44e188053a2b04fca2a9e07d2726af0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c44d6b2b02c0b515cd6e2f4d9892c368", "refinement_interpretation_Tm_refine_c511d7e559ebbc66a27408da951ecc50", - "refinement_interpretation_Tm_refine_fec2f0b77e6a261e4db626ed66e17e53", - "typing_Crypto.Symmetric.Poly1305.MAC.State.r", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.is_in", - "typing_FStar.Seq.length" + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__r", + "typing_Crypto.Symmetric.Poly1305.sel_elem", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.is_in", "typing_FStar.Seq.length" ], 0 ], @@ -1179,8 +1072,8 @@ "refinement_interpretation_Tm_refine_3201164f3fd34668bc5e4add1cefd491", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "typing_Crypto.Symmetric.AES.v", - "typing_FStar.Buffer.MkBuffer.max_length", "typing_FStar.Seq.length", - "typing_FStar.UInt32.v" + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.Seq.length", "typing_FStar.UInt32.v" ], 0 ], @@ -1218,10 +1111,10 @@ "projection_inverse_BoxInt_proj_0", "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_3201164f3fd34668bc5e4add1cefd491", + "refinement_interpretation_Tm_refine_44b47540f967ebd7b9d4b2a90dbab172", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", - "refinement_interpretation_Tm_refine_fec2f0b77e6a261e4db626ed66e17e53", - "typing_Crypto.Symmetric.Poly1305.MAC.State.s", + "typing_Crypto.Symmetric.Poly1305.MAC.__proj__State__item__s", "typing_FStar.Buffer.as_seq" ], 0 diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Spec.fst b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Spec.fst index 7b88187094e..cc5f5ea7838 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Spec.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.Spec.fst @@ -226,7 +226,7 @@ private let rec lemma_sane_eq_poly (p0:seq elem) (p1:seq elem) (r:elem) : Lemma //16-10-15 to stay close to the paper, we may apply "encode" in the poly specification private let fix (r:word_16) (i:nat {i < 16}) m : Tot word_16 = - Seq.upd r i (U8 (Seq.index r i &^ m)) + Seq.upd r i (U8.(Seq.index r i &^ m)) // an abstract spec of clamping for our state invariant // for our polynomial-sampling assumption, diff --git a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.fst b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.fst index 39d74572af5..352caa9f4a6 100644 --- a/examples/low-level/crypto/Crypto.Symmetric.Poly1305.fst +++ b/examples/low-level/crypto/Crypto.Symmetric.Poly1305.fst @@ -31,6 +31,11 @@ module U32 = FStar.UInt32 module U64 = FStar.UInt64 module HS = FStar.HyperStack +(* 2016-11-22: we now forbid opening the current module name as a +namespace, so we need to make the following abbrevs explicit *) +module Spec = Crypto.Symmetric.Poly1305.Spec +module Parameters = Crypto.Symmetric.Poly1305.Parameters + #set-options "--initial_fuel 0 --max_fuel 0 --initial_ifuel 0 --max_ifuel 0 --z3rlimit 20" // we may separate field operations, so that we don't @@ -70,9 +75,9 @@ let rec _read_word len b s i = else begin let x = b.(i) in - let s' = FStar.Seq (s @| Seq.create 1 x) in + let s' = FStar.Seq.(s @| Seq.create 1 x) in Seq.lemma_eq_intro s' (Seq.slice (sel_word h b) 0 (w i + 1)); - _read_word len b s' (U32 (i +^ 1ul)) + _read_word len b s' (U32.(i +^ 1ul)) end val read_word: len:u32 -> b:wordB{length b == w len} -> ST word @@ -250,7 +255,7 @@ let add_and_multiply acc block r = cut (eval h1 acc 5 == eval h0 acc 5 + eval h0 block 5); bound27_isSum h0 h1 acc block; push_frame(); - let tmp = create 0UL (U32 (2ul *^ nlength -^ 1ul)) in + let tmp = create 0UL (U32.(2ul *^ nlength -^ 1ul)) in let h2 = ST.get () in eval_eq_lemma h1 h2 acc acc norm_length; eval_eq_lemma h0 h2 r r norm_length; @@ -296,7 +301,7 @@ private val mk_mask: nbits:FStar.UInt32.t{FStar.UInt32.v nbits < 64} -> Tot (z:U64.t{v z == pow2 (FStar.UInt32.v nbits) - 1}) let mk_mask nbits = Math.Lemmas.pow2_lt_compat 64 (FStar.UInt32.v nbits); - U64 ((1uL <<^ nbits) -^ 1uL) + U64.((1uL <<^ nbits) -^ 1uL) (* TODO *) let lemma_toField_1 (b:elemB) (s:wordB_16{disjoint b s}) h n0 n1 n2 n3 : Lemma @@ -598,7 +603,7 @@ let trunc1305 a b = (* Clamps the key, see RFC we clear 22 bits out of 128 (where does it help?) *) -private let fix r i mask = r.(i) <- U8(r.(i) &^ mask) +private let fix r i mask = r.(i) <- U8.(r.(i) &^ mask) val clamp: r:wordB{length r == 16} -> Stack unit (requires (fun h -> live h r)) @@ -739,15 +744,16 @@ let poly1305_update log msgB acc r = #set-options "--z3rlimit 40 --initial_fuel 0 --max_fuel 0 --initial_ifuel 0 --max_ifuel 0" -val append_as_seq_sub: h:mem -> n:UInt32.t -> m:UInt32.t -> msg:bytes{live h msg /\ w m <= w n /\ w n <= length msg} -> Lemma +(* 2016-11-23: n shadowed by U32.n by local open, so rename into n' *) +val append_as_seq_sub: h:mem -> n':UInt32.t -> m:UInt32.t -> msg:bytes{live h msg /\ w m <= w n' /\ w n' <= length msg} -> Lemma (append (as_seq h (Buffer.sub msg 0ul m)) - (as_seq h (Buffer.sub (Buffer.offset msg m) 0ul (U32 (n -^ m)))) == - as_seq h (Buffer.sub msg 0ul n)) -let append_as_seq_sub h n m msg = + (as_seq h (Buffer.sub (Buffer.offset msg m) 0ul (U32.(n' -^ m)))) == + as_seq h (Buffer.sub msg 0ul n')) +let append_as_seq_sub h n' m msg = Seq.lemma_eq_intro (append (as_seq h (Buffer.sub msg 0ul m)) - (as_seq h (Buffer.sub (Buffer.offset msg m) 0ul (U32 (n -^ m))))) - (as_seq h (Buffer.sub msg 0ul n)) + (as_seq h (Buffer.sub (Buffer.offset msg m) 0ul (U32.(n' -^ m))))) + (as_seq h (Buffer.sub msg 0ul n')) (* Loop over Poly1305_update; could go below MAC *) val poly1305_loop: current_log:log_t -> msg:bytes -> acc:elemB{disjoint msg acc} -> @@ -784,7 +790,7 @@ let rec poly1305_loop log msg acc r ctr = assert (mac_log ==> sel_elem h1 acc == poly (ilog log1) (sel_elem h0 r)); assert (mac_log ==> ilog log1 == SeqProperties.snoc (ilog log) (encode (sel_word h1 msg0))); - let log2 = poly1305_loop log1 msg1 acc r (U32 (ctr -^ 1ul)) in + let log2 = poly1305_loop log1 msg1 acc r (U32.(ctr -^ 1ul)) in let h2 = ST.get () in assert (norm h2 acc /\ modifies_1 acc h0 h2); lemma_modifies_1_trans acc h0 h1 h2; @@ -797,7 +803,7 @@ let rec poly1305_loop log msg acc r ctr = // (as_seq h0 (Buffer.sub msg1 0ul (UInt32.mul 16ul (ctr -| 1ul)))) == //encode_pad (SeqProperties.snoc (ilog log) (encode (sel_word h1 msg0))) // (as_seq h0 (Buffer.sub (Buffer.offset msg 16ul) 0ul (UInt32.mul 16ul ctr -| 16ul)))); - encode_pad_snoc (ilog log) (as_seq h0 (Buffer.sub (Buffer.offset msg 16ul) 0ul (U32 (16ul *^ ctr -^ 16ul)))) (sel_word h1 msg0); + encode_pad_snoc (ilog log) (as_seq h0 (Buffer.sub (Buffer.offset msg 16ul) 0ul (U32.(16ul *^ ctr -^ 16ul)))) (sel_word h1 msg0); append_as_seq_sub h0 (UInt32.mul 16ul ctr) 16ul msg //assert (append (sel_word h1 msg0) (as_seq h0 (Buffer.sub (Buffer.offset msg 16ul) 0ul (UInt32.mul 16ul ctr -| 16ul))) == // (as_seq h0 (Buffer.sub msg 0ul (UInt32.mul 16ul ctr)))) @@ -903,8 +909,8 @@ let poly1305_finish tag acc s = val div_aux: a:UInt32.t -> b:UInt32.t{w b <> 0} -> Lemma (requires True) - (ensures FStar.UInt32(UInt.size (v a / v b) n)) - [SMTPat (FStar.UInt32(UInt.size (v a / v b) n))] + (ensures FStar.UInt32.(UInt.size (v a / v b) n)) + [SMTPat (FStar.UInt32.(UInt.size (v a / v b) n))] let div_aux a b = () #reset-options "--z3rlimit 100 --initial_fuel 1 --max_fuel 1" @@ -947,7 +953,7 @@ let poly1305_mac tag msg len key = let l = poly1305_loop l msg acc r ctr in assume False; // TODO: REMOVE ME (* Run the poly1305_update function one more time on the last incomplete block *) - let last_block = sub msg (FStar.UInt32 (ctr *^ 16ul)) rest in + let last_block = sub msg (FStar.UInt32.(ctr *^ 16ul)) rest in poly1305_last l last_block acc r rest; (* Finish *) poly1305_finish tag acc (sub key 16ul 16ul); // should be s diff --git a/examples/low-level/crypto/Crypto.Test.fst b/examples/low-level/crypto/Crypto.Test.fst index 650983d9228..48cc9e02acf 100644 --- a/examples/low-level/crypto/Crypto.Test.fst +++ b/examples/low-level/crypto/Crypto.Test.fst @@ -131,7 +131,7 @@ let rec store_bytestring len buf i s = let x1 = digit (String.index s (UInt32.v i + UInt32.v i)) in let x0 = digit (String.index s (UInt32.v i + UInt32.v i + 1)) in //assert(x1 <^ 16uy /\ x0 <^ 16uy); - Buffer.upd buf i (FStar.UInt8(x1 *^ 16uy +^ x0)); + Buffer.upd buf i (FStar.UInt8.(x1 *^ 16uy +^ x0)); store_bytestring len buf (FStar.UInt32(i +^ 1ul)) s ) let from_bytestring s = @@ -207,14 +207,14 @@ let test() = // To prove the assertion below for the concrete constants in PRF, AEAD: assert_norm (114 <= pow2 14); - assert_norm (FStar.Mul(114 <= 1999 * 64)); + assert_norm (FStar.Mul.(114 <= 1999 * 64)); assert(AETypes.safelen i (v plainlen) 1ul); //NS: These 3 separation properties are explicitly violated by allocating st in HH.root // Assuming them for the moment assume ( - HH.disjoint (Buffer.frameOf (Plain.as_buffer plain)) (AETypes st.log_region) /\ - HH.disjoint (Buffer.frameOf cipher) (AETypes st.log_region) /\ - HH.disjoint (Buffer.frameOf aad) (AETypes st.log_region) + HH.disjoint (Buffer.frameOf (Plain.as_buffer plain)) (AETypes.(st.log_region)) /\ + HH.disjoint (Buffer.frameOf cipher) (AETypes.(st.log_region)) /\ + HH.disjoint (Buffer.frameOf aad) (AETypes.(st.log_region)) ); AE.encrypt i st iv aadlen aad plainlen plain cipher; let ok_0 = diff "cipher" cipherlen expected_cipher cipher in @@ -253,8 +253,8 @@ let main argc argv = C.exit_success -private let hex1 (x:UInt8.t {FStar.UInt8(x <^ 16uy)}) = - FStar.UInt8( +private let hex1 (x:UInt8.t {FStar.UInt8.(x <^ 16uy)}) = + FStar.UInt8.( if x <^ 10uy then UInt8.to_string x else if x = 10uy then "a" else if x = 11uy then "b" else @@ -262,7 +262,7 @@ private let hex1 (x:UInt8.t {FStar.UInt8(x <^ 16uy)}) = if x = 13uy then "d" else if x = 14uy then "e" else "f") private let hex2 x = - FStar.UInt8(hex1 (x /^ 16uy) ^ hex1 (x %^ 16uy)) + FStar.UInt8.(hex1 (x /^ 16uy) ^ hex1 (x %^ 16uy)) val print_buffer: s:buffer -> i:UInt32.t{UInt32.v i <= length s} -> len:UInt32.t{UInt32.v len <= length s} -> Stack unit (requires (fun h -> live h s)) diff --git a/examples/low-level/crypto/Crypto.Test.fst.hints b/examples/low-level/crypto/Crypto.Test.fst.hints new file mode 100644 index 00000000000..1276673f077 --- /dev/null +++ b/examples/low-level/crypto/Crypto.Test.fst.hints @@ -0,0 +1,944 @@ +[ + "\b\\5HYcJ#O\u0017\u001a\u0006", + [ + [ + "Crypto.Test.mk_buf_t", + 1, + 0, + 1, + [ "@query", "assumption_Prims.HasEq_int" ], + 0 + ], + [ + "Crypto.Test.mk_buf_t", + 2, + 0, + 1, + [ + "@query", "assumption_Prims.HasEq_int", "equation_Prims.nat", + "haseqTm_refine_ba523126f67e00e7cd55f0b92f16681d" + ], + 0 + ], + [ + "Crypto.Test.mk_buf_t", + 3, + 0, + 1, + [ "@query", "assumption_FStar.HyperHeap.HasEq_rid" ], + 0 + ], + [ + "Crypto.Test.mk_buf_t", + 4, + 0, + 1, + [ "@query", "assumption_FStar.HyperHeap.HasEq_rid" ], + 0 + ], + [ + "Crypto.Test.mk_buf_t", + 5, + 0, + 1, + [ "@query", "assumption_FStar.HyperHeap.HasEq_rid" ], + 0 + ], + [ + "Crypto.Test.mk_buf_t", + 6, + 0, + 1, + [ "@query", "assumption_FStar.HyperHeap.HasEq_rid" ], + 0 + ], + [ + "Crypto.Test.mk_aad", + 1, + 0, + 1, + [ + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "data_elim_FStar.UInt8.Mk", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.GF128.r_mul", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_FStar.UInt8.uint_to_t", "equation_Prims.nat", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Symmetric.GF128.r_mul", + "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", + "int_inversion", "int_typing", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_Flag.safeHS" + ], + 0 + ], + [ + "Crypto.Test.mk_aad", + 2, + 0, + 1, + [ "@query", "projection_inverse_BoxInt_proj_0" ], + 0 + ], + [ + "Crypto.Test.mk_key", + 1, + 0, + 1, + [ + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "data_elim_FStar.UInt8.Mk", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.GF128.r_mul", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_FStar.UInt8.uint_to_t", "equation_Prims.nat", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Symmetric.GF128.r_mul", + "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", + "int_inversion", "int_typing", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_Flag.safeHS" + ], + 0 + ], + [ + "Crypto.Test.mk_key", + 2, + 0, + 1, + [ "@query", "projection_inverse_BoxInt_proj_0" ], + 0 + ], + [ + "Crypto.Test.mk_ivBuffer", + 1, + 0, + 1, + [ + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "data_elim_FStar.UInt8.Mk", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Chacha20.blocklen", + "equation_Crypto.Symmetric.GF128.r_mul", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_FStar.UInt8.uint_to_t", "equation_Prims.nat", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Symmetric.Chacha20.blocklen", + "function_token_typing_Crypto.Symmetric.GF128.r_mul", + "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", + "int_inversion", "int_typing", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt.fits", + "typing_Flag.safeHS" + ], + 0 + ], + [ + "Crypto.Test.mk_ivBuffer", + 2, + 0, + 1, + [ "@query", "projection_inverse_BoxInt_proj_0" ], + 0 + ], + [ + "Crypto.Test.load_string", + 1, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.load_string", + 2, + 0, + 1, + [ + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Bytes.buffer", + "equation_Crypto.Symmetric.Bytes.lbuffer", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", + "equation_FStar.HyperStack.equal_domains", + "equation_FStar.HyperStack.hh", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.n", + "equation_FStar.UInt8.t", "equation_Prims.eqtype", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.HyperStack.reference", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.UInt8.n", "int_inversion", "int_typing", + "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt8.t_@tok", + "lemma_FStar.Int.pow2_values", "lemma_FStar.Set.lemma_equal_refl", + "lemma_FStar.TSet.lemma_equal_refl", + "pretyping_6c86c071b92797cdf01eb016249a9465", + "pretyping_ce036b6b736ef4e0bc3a9ff132a12aed", + "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_Equality", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "proj_equation_FStar.Buffer.MkBuffer_content", + "proj_equation_FStar.Buffer.MkBuffer_length", + "proj_equation_FStar.HyperStack.HS_h", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", + "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_4443aec68c3f169bb1ee3b95785469b2", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_c54dcb782be971742f65876a3620f44b", + "refinement_interpretation_Tm_refine_c977f2d058f4105fd2afa6d9b48de36b", + "refinement_interpretation_Tm_refine_d36a71b8a71855a11d8b101c5e05fd3d", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.__proj__MkBuffer__item__max_length", + "typing_FStar.Buffer.length", "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.load_string", + 3, + 0, + 1, + [ + "@query", "assumption_FStar.UInt32.t__haseq", + "equation_FStar.UInt32.t" + ], + 0 + ], + [ + "Crypto.Test.store_string", + 1, + 0, + 1, + [ + "@query", "assumption_Prims.HasEq_int", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", + "haseqTm_refine_e0b8a7ce8790eaaca2b2e4fb4d625bad", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v" + ], + 0 + ], + [ + "Crypto.Test.store_string", + 2, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.store_string", + 3, + 0, + 1, + [ + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Bytes.buffer", + "equation_Crypto.Symmetric.Bytes.lbuffer", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.length", + "equation_FStar.Char.char_code", "equation_FStar.HyperHeap.t", + "equation_FStar.HyperStack.equal_domains", + "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", + "equation_FStar.Mul.op_Star", "equation_FStar.UInt.fits", + "equation_FStar.UInt.lt", "equation_FStar.UInt.lte", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.lt", + "equation_FStar.UInt32.lte", "equation_FStar.UInt32.mul", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_Prims._assert", "equation_Prims.eqtype", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Symmetric.Poly1305.MAC.someId", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.List.Tot.test_sort", + "function_token_typing_FStar.UInt8.n", "int_inversion", "int_typing", + "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt8.t_@tok", + "lemma_FStar.Buffer.lemma_modifies_1_trans", + "lemma_FStar.Buffer.lemma_modifies_sub_1", + "lemma_FStar.Buffer.lemma_size", + "lemma_FStar.HyperStack.lemma_equal_domains_trans", + "lemma_FStar.Int.pow2_values", "lemma_FStar.Set.lemma_equal_refl", + "lemma_FStar.TSet.lemma_equal_refl", + "pretyping_6c86c071b92797cdf01eb016249a9465", + "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_LessThan", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "proj_equation_FStar.Buffer.MkBuffer_length", + "proj_equation_FStar.HyperStack.HS_h", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", + "refinement_interpretation_Tm_refine_0e3e560c796fef6df2d948e98bb1d5d6", + "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_5ab7ef82d7eb3e831475b507b61876a3", + "refinement_interpretation_Tm_refine_63d06a8735e3b5c1eef115e81e74d0be", + "refinement_interpretation_Tm_refine_7148cbb104ff25a5758faf4b8b8d55af", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_e21b22668ee258465249d73c3315e71f", + "string_inversion", "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.domain", "typing_FStar.Map.sel", + "typing_FStar.UInt.fits", "typing_FStar.UInt32.lte", + "typing_FStar.UInt32.v", "typing_Flag.safeHS", "unit_inversion" + ], + 0 + ], + [ + "Crypto.Test.from_string", + 1, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.from_string", + 2, + 0, + 1, + [ + "@query", "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", + "bool_inversion", "bool_typing", "data_elim_FStar.Buffer.MkBuffer", + "data_elim_FStar.UInt8.Mk", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Bytes.buffer", + "equation_Crypto.Symmetric.Bytes.lbuffer", + "equation_Crypto.Symmetric.GF128.r_mul", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.idx", + "equation_FStar.Buffer.length", "equation_FStar.HyperHeap.t", + "equation_FStar.HyperStack.equal_domains", + "equation_FStar.HyperStack.hh", + "equation_FStar.HyperStack.is_stack_region", + "equation_FStar.Mul.op_Star", "equation_FStar.ST.inline_stack_inv", + "equation_FStar.UInt.fits", "equation_FStar.UInt.lte", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.mul", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.lte", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.n", + "equation_FStar.UInt8.t", "equation_FStar.UInt8.uint_to_t", + "equation_Prims._assert", "equation_Prims.eqtype", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.GF128.r_mul", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", "int_inversion", + "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt8.t_@tok", + "lemma_FStar.Buffer.lemma_modifies_0_1_", + "lemma_FStar.Map.lemma_ContainsDom", + "lemma_FStar.Set.lemma_equal_elim", + "lemma_FStar.TSet.lemma_equal_elim", + "pretyping_6c86c071b92797cdf01eb016249a9465", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "proj_equation_FStar.Buffer.MkBuffer_idx", + "proj_equation_FStar.Buffer.MkBuffer_length", + "proj_equation_FStar.HyperStack.HS_h", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", + "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.Map.contains", "typing_FStar.Map.domain", + "typing_FStar.Map.sel", "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.from_string", + 3, + 0, + 1, + [ + "@query", "assumption_Prims.HasEq_int", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", + "haseqTm_refine_e0b8a7ce8790eaaca2b2e4fb4d625bad", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v" + ], + 0 + ], + [ + "Crypto.Test.diff", + 1, + 0, + 1, + [ + "@query", "data_elim_FStar.UInt32.Mk", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.n", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "fuel_guarded_inversion_FStar.UInt32.t_", "int_inversion", + "int_typing", "lemma_FStar.Buffer.lemma_size", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d" + ], + 0 + ], + [ + "Crypto.Test.diff", + 2, + 0, + 1, + [ + "@query", "b2t_def", "bool_inversion", "bool_typing", + "data_elim_FStar.UInt32.Mk", "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Bytes.buffer", + "equation_Crypto.Symmetric.Bytes.lbuffer", + "equation_Crypto.Test.verbose", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperStack.contains", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.HyperStack.mem", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Test.verbose", "int_inversion", + "int_typing", "kinding_FStar.UInt8.t_@tok", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_BarBar", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Negation", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.Buffer.length", + "typing_FStar.UInt.fits" + ], + 0 + ], + [ + "Crypto.Test.diff", + 3, + 0, + 1, + [ + "@query", "assumption_FStar.UInt8.t__haseq", "equation_FStar.UInt8.t" + ], + 0 + ], + [ + "Crypto.Test.dump", + 1, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.dump", + 2, + 0, + 1, + [ + "@query", "assumption_FStar.HyperHeap.HasEq_rid", + "equation_Crypto.Test.verbose", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", + "equation_FStar.HyperStack.equal_stack_domains", + "equation_FStar.HyperStack.hh", "equation_FStar.List.Tot.test_sort", + "equation_FStar.UInt8.t", "equation_Prims._assert", + "equation_Prims.eqtype", + "fuel_guarded_inversion_FStar.HyperStack.mem", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.List.Tot.test_sort", + "kinding_FStar.Heap.aref@tok", "lemma_FStar.TSet.lemma_equal_refl", + "pretyping_6c86c071b92797cdf01eb016249a9465", + "primitive_Prims.op_AmpAmp", "proj_equation_FStar.HyperStack.HS_h", + "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", "typing_FStar.Map.sel" + ], + 0 + ], + [ + "Crypto.Test.test", + 1, + 0, + 1, + [ + "@query", "assumption_FStar.Heap.DomContains", + "assumption_FStar.HyperHeap.HasEq_rid", "b2t_def", "bool_inversion", + "bool_typing", + "constructor_distinct_Crypto.Symmetric.Cipher.CHACHA20", + "constructor_distinct_Flag.CHACHA20_POLY1305", + "data_elim_FStar.Buffer.MkBuffer", "data_elim_FStar.HyperStack.HS", + "data_elim_FStar.HyperStack.MkRef", "data_elim_FStar.UInt32.Mk", + "data_elim_FStar.UInt8.Mk", + "equality_tok_Crypto.AEAD.Invariant.Reader@tok", + "equality_tok_Crypto.AEAD.Invariant.Writer@tok", + "equality_tok_Crypto.Symmetric.Cipher.CHACHA20@tok", + "equality_tok_Flag.CHACHA20_POLY1305@tok", + "equation_Crypto.AEAD.Encoding.aadmax", + "equation_Crypto.AEAD.Encoding.alg", + "equation_Crypto.AEAD.Encoding.id", + "equation_Crypto.AEAD.Invariant.maxplain", + "equation_Crypto.AEAD.Invariant.safelen", "equation_Crypto.AEAD.id", + "equation_Crypto.AEAD.inv", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nb", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", + "equation_Crypto.Symmetric.Bytes.buffer", + "equation_Crypto.Symmetric.Bytes.bytes", + "equation_Crypto.Symmetric.Bytes.lbuffer", + "equation_Crypto.Symmetric.Bytes.lbytes", + "equation_Crypto.Symmetric.Bytes.sel_bytes", + "equation_Crypto.Symmetric.Chacha20.blocklen", + "equation_Crypto.Symmetric.Chacha20.ivlen", + "equation_Crypto.Symmetric.Chacha20.keylen", + "equation_Crypto.Symmetric.Cipher.blocklen", + "equation_Crypto.Symmetric.Cipher.ivlen", + "equation_Crypto.Symmetric.Cipher.keylen", + "equation_Crypto.Symmetric.GF128.len", + "equation_Crypto.Symmetric.GF128.r_mul", + "equation_Crypto.Symmetric.PRF.blocklen", + "equation_Crypto.Symmetric.PRF.keylen", + "equation_Crypto.Symmetric.PRF.maxCtr", + "equation_Crypto.Symmetric.Poly1305.Spec.taglen", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.contains", + "equation_FStar.Buffer.content", "equation_FStar.Buffer.disjoint_2", + "equation_FStar.Buffer.frameOf", "equation_FStar.Buffer.idx", + "equation_FStar.Buffer.includes", "equation_FStar.Buffer.length", + "equation_FStar.Buffer.live", + "equation_FStar.HyperHeap.contains_ref", + "equation_FStar.HyperHeap.map_invariant", + "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.contains", + "equation_FStar.HyperStack.equal_domains", + "equation_FStar.HyperStack.equal_stack_domains", + "equation_FStar.HyperStack.frameOf", + "equation_FStar.HyperStack.fresh_frame", + "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_above", + "equation_FStar.HyperStack.is_eternal_color", + "equation_FStar.HyperStack.is_eternal_region", + "equation_FStar.HyperStack.is_in", + "equation_FStar.HyperStack.is_tip", + "equation_FStar.HyperStack.live_region", + "equation_FStar.HyperStack.pop", + "equation_FStar.HyperStack.poppable", + "equation_FStar.HyperStack.popped", + "equation_FStar.HyperStack.remove_elt", + "equation_FStar.HyperStack.sid", "equation_FStar.Mul.op_Star", + "equation_FStar.ST.inline_stack_inv", "equation_FStar.UInt.div", + "equation_FStar.UInt.fits", "equation_FStar.UInt.lt", + "equation_FStar.UInt.lte", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.mul", + "equation_FStar.UInt.size", "equation_FStar.UInt.sub", + "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.div", + "equation_FStar.UInt32.lt", "equation_FStar.UInt32.lte", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.sub", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_FStar.UInt8.n", "equation_FStar.UInt8.t", + "equation_FStar.UInt8.uint_to_t", "equation_Flag.cipher_alg", + "equation_Flag.cipher_of_id", "equation_Flag.prf", + "equation_Plain.as_buffer", "equation_Plain.bufferRepr", + "equation_Plain.live", "equation_Plain.plainLen", + "equation_Prims.eqtype", "equation_Prims.nat", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", + "fuel_guarded_inversion_Crypto.Symmetric.Cipher.alg", + "fuel_guarded_inversion_FStar.Buffer._buffer", + "fuel_guarded_inversion_FStar.HyperStack.mem", + "fuel_guarded_inversion_FStar.HyperStack.reference", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.AEAD.Encoding.aadmax", + "function_token_typing_Crypto.Symmetric.AES.keylen", + "function_token_typing_Crypto.Symmetric.AES.nb", + "function_token_typing_Crypto.Symmetric.Chacha20.ivlen", + "function_token_typing_Crypto.Symmetric.Chacha20.keylen", + "function_token_typing_Crypto.Symmetric.GF128.len", + "function_token_typing_Crypto.Symmetric.GF128.r_mul", + "function_token_typing_FStar.Heap.emp", + "function_token_typing_FStar.Heap.heap", + "function_token_typing_FStar.HyperHeap.rid", + "function_token_typing_FStar.HyperHeap.root", "int_inversion", + "int_typing", "kinding_FStar.Heap.aref@tok", + "kinding_FStar.UInt8.t_@tok", "l_imp-interp", + "lemma_FStar.Buffer.lemma_disjoint_sub", + "lemma_FStar.Buffer.lemma_disjoint_sub_", + "lemma_FStar.Buffer.lemma_disjoint_symm", + "lemma_FStar.Buffer.lemma_fresh_poppable", + "lemma_FStar.Buffer.lemma_live_disjoint", + "lemma_FStar.Buffer.modifies_poppable_1", + "lemma_FStar.Buffer.no_upd_lemma_0", + "lemma_FStar.Buffer.no_upd_lemma_1", + "lemma_FStar.HyperHeap.lemma_extends_includes", + "lemma_FStar.HyperHeap.lemma_extends_parent", + "lemma_FStar.HyperHeap.lemma_includes_trans", + "lemma_FStar.HyperHeap.lemma_root_has_color_zero", + "lemma_FStar.HyperStack.lemma_equal_domains_trans", + "lemma_FStar.HyperStack.lemma_equal_stack_domains_trans", + "lemma_FStar.Int.pow2_values", "lemma_FStar.Map.lemma_ContainsDom", + "lemma_FStar.Map.lemma_SelRestrict", "lemma_FStar.Map.lemma_SelUpd2", + "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.Set.lemma_equal_elim", + "lemma_FStar.Set.mem_complement", "lemma_FStar.Set.mem_intersect", + "lemma_FStar.Set.mem_singleton", "lemma_FStar.TSet.lemma_equal_elim", + "lemma_FStar.TSet.lemma_equal_intro", "lemma_Flag.mac1_implies_prf", + "lemma_Flag.safeId_implies_mac1", + "pretyping_6c86c071b92797cdf01eb016249a9465", + "pretyping_9248629b80e5ece8a5830df634103252", + "primitive_Prims.op_Addition", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_BarBar", "primitive_Prims.op_Division", + "primitive_Prims.op_Equality", "primitive_Prims.op_LessThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Negation", "primitive_Prims.op_Subtraction", + "primitive_Prims.op_disEquality", + "proj_equation_FStar.Buffer.MkBuffer_content", + "proj_equation_FStar.Buffer.MkBuffer_idx", + "proj_equation_FStar.Buffer.MkBuffer_length", + "proj_equation_FStar.HyperStack.HS_h", + "proj_equation_FStar.HyperStack.HS_tip", + "proj_equation_FStar.HyperStack.MkRef_id", + "proj_equation_FStar.HyperStack.MkRef_ref", + "proj_equation_FStar.UInt32.Mk_v", "proj_equation_Flag.Mkid_cipher", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.HyperStack.HS_h", + "projection_inverse_FStar.UInt32.Mk_v", + "projection_inverse_Flag.Mkid_cipher", + "refinement_interpretation_Tm_refine_031aa5f46d93e5d19c7d173c1a0a0157", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", + "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", + "refinement_interpretation_Tm_refine_7778e6829125aada02b932a3a2836fc5", + "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_b560551048d2e17324f021503ddc4232", + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_c977f2d058f4105fd2afa6d9b48de36b", + "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", + "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", + "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", + "refinement_kinding_Tm_refine_474997e55e54e0875d3f887cd7682241", + "refinement_kinding_Tm_refine_8e561ff83f56135ffaf292b237824306", + "typing_Crypto.Symmetric.AES.v", + "typing_FStar.Buffer.__proj__MkBuffer__item__content", + "typing_FStar.Buffer.__proj__MkBuffer__item__idx", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", + "typing_FStar.Buffer.as_seq", "typing_FStar.Buffer.content", + "typing_FStar.Buffer.length", "typing_FStar.Heap.domain", + "typing_FStar.HyperHeap.as_ref", + "typing_FStar.HyperHeap.contains_ref", + "typing_FStar.HyperHeap.includes", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.__proj__MkRef__item__ref", + "typing_FStar.HyperStack.is_above", "typing_FStar.HyperStack.is_in", + "typing_FStar.HyperStack.is_stack_region", + "typing_FStar.HyperStack.poppable", + "typing_FStar.HyperStack.remove_elt", "typing_FStar.Map.contains", + "typing_FStar.Map.domain", "typing_FStar.Map.restrict", + "typing_FStar.Map.sel", "typing_FStar.Set.complement", + "typing_FStar.Set.singleton", "typing_FStar.UInt.fits", + "typing_FStar.UInt32.lte", "typing_FStar.UInt32.uint_to_t", + "typing_FStar.UInt32.v", "typing_Flag.cipher_of_id", + "typing_Flag.prf", "typing_Plain.as_buffer" + ], + 0 + ], + [ + "Crypto.Test.test", + 2, + 0, + 1, + [ + "@query", "assumption_Prims.HasEq_int", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", + "haseqTm_refine_89ca984d58100ebf87df2ad1ed88d530", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v" + ], + 0 + ], + [ + "Crypto.Test.test", + 3, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.test", + 4, + 0, + 1, + [ + "@query", "data_elim_Crypto.AEAD.Invariant.State", + "equality_tok_Crypto.AEAD.Invariant.Writer@tok", + "equation_Crypto.AEAD.Encoding.id", + "equation_Crypto.AEAD.Invariant.id", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47" + ], + 0 + ], + [ + "Crypto.Test.test", + 5, + 0, + 1, + [ + "@query", "data_elim_Crypto.AEAD.Invariant.State", + "equality_tok_Crypto.AEAD.Invariant.Writer@tok", + "equation_Crypto.AEAD.Encoding.id", + "equation_Crypto.AEAD.Invariant.id", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47" + ], + 0 + ], + [ + "Crypto.Test.test", + 6, + 0, + 1, + [ + "@query", "data_elim_Crypto.AEAD.Invariant.State", + "equality_tok_Crypto.AEAD.Invariant.Writer@tok", + "equation_Crypto.AEAD.Encoding.id", + "equation_Crypto.AEAD.Invariant.id", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47" + ], + 0 + ], + [ + "Crypto.Test.test", + 7, + 0, + 1, + [ + "@query", "data_elim_Crypto.AEAD.Invariant.State", + "equality_tok_Crypto.AEAD.Invariant.Writer@tok", + "equation_Crypto.AEAD.Encoding.id", + "equation_Crypto.AEAD.Invariant.id", + "fuel_guarded_inversion_Crypto.AEAD.Invariant.state", + "refinement_interpretation_Tm_refine_938fa922c23d02bb72c36d0ecc19aa47" + ], + 0 + ], + [ + "Crypto.Test.test", + 8, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ + "Crypto.Test.test", + 9, + 0, + 1, + [ + "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", + "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", + "typing_FStar.UInt32.v" + ], + 0 + ], + [ "Crypto.Test.main", 1, 0, 1, [ "@query" ], 0 ] + ] +] \ No newline at end of file diff --git a/examples/low-level/crypto/Plain.fst b/examples/low-level/crypto/Plain.fst index bc0c5a6a167..9e15f9a65af 100644 --- a/examples/low-level/crypto/Plain.fst +++ b/examples/low-level/crypto/Plain.fst @@ -78,6 +78,7 @@ let as_buffer_injective i l p = () let live #i #l h (p:plainBuffer i l) = Buffer.live h (as_buffer p) +private let live' = live (* live may be shadowed by Buffer.live in case of local open *) // unconditional access in specs; rename to as_plain? val sel_plain: h:mem -> #i:id -> l:UInt32.t -> buf:plainBuffer i (v l){live h buf} -> GTot (plain i (v l)) @@ -94,6 +95,7 @@ let create (i:id) (zero:UInt8.t) (len:UInt32.t) : (ensures (fun (h0:mem) p h1 -> let b = as_buffer p in let open FStar.Buffer in + let live = live' in (* to undo shadowing by FStar.Buffer.live *) ~(contains h0 b) /\ live h1 p /\ idx b = 0 /\ length b = v len /\ frameOf b = h0.tip @@ -104,8 +106,8 @@ let create (i:id) (zero:UInt8.t) (len:UInt32.t) : = Buffer.create zero len let sub #id #l (b:plainBuffer id l) - (i:UInt32.t{FStar.Buffer (v i + v (as_buffer b).idx) < pow2 n}) - (len:UInt32.t{FStar.Buffer (v len <= length (as_buffer b) /\ v i + v len <= length (as_buffer b))}) : Tot (b':plainBuffer id (v len)) + (i:UInt32.t{FStar.Buffer.(v i + v (as_buffer b).idx) < pow2 n}) + (len:UInt32.t{FStar.Buffer.(v len <= length (as_buffer b) /\ v i + v len <= length (as_buffer b))}) : Tot (b':plainBuffer id (v len)) = Buffer.sub b i len // ... diff --git a/examples/low-level/crypto/Plain.fst.hints b/examples/low-level/crypto/Plain.fst.hints index ef1dd14fa58..cd4c86d3eea 100644 --- a/examples/low-level/crypto/Plain.fst.hints +++ b/examples/low-level/crypto/Plain.fst.hints @@ -1,5 +1,5 @@ [ - "ye\u0019YQ=\u0001M", + "S=櫉. \u0014\nMi", [ [ "Plain.repr", @@ -8,13 +8,10 @@ 1, [ "@query", "assumption_FStar.Seq.seq_haseq", - "assumption_FStar.UInt8.t__haseq", "assumption_Prims.HasEq_int", + "assumption_FStar.UInt8.t__haseq", "equation_Crypto.Symmetric.Bytes.bytes", "equation_FStar.UInt8.t", - "equation_Plain.plainLen", "equation_Prims.nat", - "haseqTm_refine_ba523126f67e00e7cd55f0b92f16681d", - "haseqTm_refine_c035ebcf0a64c9d71ea03c34bbe7f0a8", "int_inversion", - "kinding_FStar.UInt8.t_@tok", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d" + "haseqTm_refine_c035ebcf0a64c9d71ea03c34bbe7f0a8", + "kinding_FStar.UInt8.t_@tok" ], 0 ], @@ -26,13 +23,10 @@ 1, [ "@query", "assumption_FStar.Seq.seq_haseq", - "assumption_FStar.UInt8.t__haseq", "assumption_Prims.HasEq_int", + "assumption_FStar.UInt8.t__haseq", "equation_Crypto.Symmetric.Bytes.bytes", "equation_FStar.UInt8.t", - "equation_Plain.plainLen", "equation_Prims.nat", - "haseqTm_refine_ba523126f67e00e7cd55f0b92f16681d", - "haseqTm_refine_c035ebcf0a64c9d71ea03c34bbe7f0a8", "int_inversion", - "kinding_FStar.UInt8.t_@tok", - "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d" + "haseqTm_refine_c035ebcf0a64c9d71ea03c34bbe7f0a8", + "kinding_FStar.UInt8.t_@tok" ], 0 ], @@ -123,7 +117,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -135,10 +131,21 @@ 0, 1, [ - "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "@query", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_Prims.nat", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", + "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "typing_FStar.UInt32.v" + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v" ], 0 ], @@ -148,9 +155,8 @@ 0, 1, [ - "@query", "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", - "equation_Plain.as_buffer", "equation_Plain.live", - "fuel_guarded_inversion_Flag.id" + "@query", "equation_FStar.UInt32.v", "equation_Plain.as_buffer", + "equation_Plain.live", "fuel_guarded_inversion_Flag.id" ], 0 ], @@ -183,7 +189,7 @@ "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", "equation_Plain.as_buffer", "equation_Plain.live", "equation_Plain.plainBuffer", "equation_Plain.plainLen", - "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer.buffer_", + "equation_Prims.nat", "fuel_guarded_inversion_FStar.Buffer._buffer", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "fuel_guarded_inversion_Flag.id", @@ -207,7 +213,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -220,7 +228,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -241,8 +251,11 @@ 1, [ "@query", "assumption_Prims.HasEq_int", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "haseqTm_refine_e0b8a7ce8790eaaca2b2e4fb4d625bad", - "projection_inverse_BoxInt_proj_0" + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v" ], 0 ], @@ -285,7 +298,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -298,7 +313,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -319,8 +336,11 @@ 1, [ "@query", "assumption_Prims.HasEq_int", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "haseqTm_refine_e0b8a7ce8790eaaca2b2e4fb4d625bad", - "projection_inverse_BoxInt_proj_0" + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v" ], 0 ], @@ -372,8 +392,8 @@ "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "refinement_interpretation_Tm_refine_27eb738955e795e5dd1cab5fe18de9a0", + "refinement_interpretation_Tm_refine_565a37ff3f9acc0c7ae83bc3e848ab17", "refinement_interpretation_Tm_refine_879d07b2782dba288501aad624b84da8", - "refinement_interpretation_Tm_refine_9ac3e1b22fc634b33402e3e632437c19", "typing_FStar.UInt32.v" ], 0 @@ -385,7 +405,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -398,7 +420,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -411,7 +435,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -423,10 +449,21 @@ 0, 1, [ - "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "@query", "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "equation_Prims.nat", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", + "lemma_FStar.Buffer.lemma_size", "primitive_Prims.op_Multiply", + "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "typing_FStar.UInt32.v" + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v" ], 0 ], @@ -442,6 +479,7 @@ "equation_Crypto.Symmetric.Bytes.lbuffer", "equation_Crypto.Symmetric.Bytes.lbytes", "equation_Crypto.Symmetric.Bytes.sel_bytes", + "equation_FStar.Buffer.buffer", "equation_FStar.Buffer.length", "equation_FStar.HyperHeap.t", "equation_FStar.HyperStack.equal_stack_domains", "equation_FStar.HyperStack.hh", "equation_FStar.UInt32.t", @@ -458,15 +496,19 @@ "kinding_FStar.Heap.aref@tok", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Seq.lemma_eq_elim", "lemma_FStar.TSet.lemma_equal_refl", "pretyping_6c86c071b92797cdf01eb016249a9465", + "proj_equation_FStar.Buffer.MkBuffer_length", "proj_equation_FStar.HyperStack.HS_h", + "proj_equation_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", + "typing_FStar.Buffer.__proj__MkBuffer__item__length", "typing_FStar.Buffer.as_seq", "typing_FStar.Heap.domain", - "typing_FStar.HyperStack.HS.h", "typing_FStar.Map.sel" + "typing_FStar.HyperStack.__proj__HS__item__h", "typing_FStar.Map.sel" ], 0 ], @@ -477,7 +519,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -490,7 +534,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -503,7 +549,9 @@ 1, [ "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "equation_FStar.UInt32.uint_to_t", "equation_FStar.UInt32.v", + "lemma_FStar.Buffer.lemma_size", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", "typing_FStar.UInt32.v" ], @@ -515,10 +563,23 @@ 0, 1, [ - "@query", "equation_FStar.UInt.uint_t", "equation_FStar.UInt32.n", - "equation_FStar.UInt32.v", "lemma_FStar.Buffer.lemma_size", + "@query", "data_elim_FStar.UInt32.Mk", + "equation_Crypto.Symmetric.AES.keylen", + "equation_Crypto.Symmetric.AES.nk", + "equation_Crypto.Symmetric.AES.v", "equation_FStar.Mul.op_Star", + "equation_FStar.UInt.mul", "equation_FStar.UInt.uint_t", + "equation_FStar.UInt32.mul", "equation_FStar.UInt32.n", + "equation_FStar.UInt32.t", "equation_FStar.UInt32.uint_to_t", + "equation_FStar.UInt32.v", "equation_Prims.nat", + "fuel_guarded_inversion_FStar.UInt32.t_", + "function_token_typing_Crypto.Symmetric.AES.keylen", "int_inversion", + "int_typing", "lemma_FStar.Buffer.lemma_size", + "primitive_Prims.op_Multiply", "proj_equation_FStar.UInt32.Mk_v", + "projection_inverse_BoxInt_proj_0", + "projection_inverse_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_03d0bed5c0733099844f268aecd0836d", - "typing_FStar.UInt32.v" + "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "typing_Crypto.Symmetric.AES.v", "typing_FStar.UInt32.v" ], 0 ], @@ -532,20 +593,26 @@ "equation_Crypto.Symmetric.Bytes.bytes", "equation_Crypto.Symmetric.Bytes.lbuffer", "equation_Crypto.Symmetric.Bytes.lbytes", + "equation_Crypto.Symmetric.Bytes.mem", "equation_Crypto.Symmetric.Bytes.sel_bytes", - "equation_FStar.UInt32.t", "equation_FStar.UInt32.v", - "equation_FStar.UInt8.t", "equation_Plain.as_buffer", - "equation_Plain.live", "equation_Plain.plain", - "equation_Plain.plainBuffer", "equation_Plain.sel_plain", + "equation_FStar.Buffer.as_seq", "equation_FStar.Buffer.buffer", + "equation_FStar.Buffer.length", "equation_FStar.UInt32.t", + "equation_FStar.UInt32.v", "equation_FStar.UInt8.t", + "equation_Plain.as_buffer", "equation_Plain.live", + "equation_Plain.plain", "equation_Plain.plainBuffer", + "equation_Plain.sel_plain", "fuel_guarded_inversion_FStar.HyperStack.mem", "fuel_guarded_inversion_FStar.UInt32.t_", "fuel_guarded_inversion_Flag.id", "kinding_FStar.UInt8.t_@tok", "lemma_FStar.Seq.lemma_eq_elim", + "proj_equation_FStar.Buffer.MkBuffer_length", + "proj_equation_FStar.UInt32.Mk_v", "refinement_interpretation_Tm_refine_1b5d9020cc8f44163e9c491b867a8c24", - "refinement_interpretation_Tm_refine_46641acd90d2b6089d6e481fd82969c8", - "refinement_interpretation_Tm_refine_7e3beb6acccffb41919f80afab550fdd", + "refinement_interpretation_Tm_refine_a2e6366d2de5a2469cf7063420642cdc", + "refinement_interpretation_Tm_refine_a917a802cdb0c45fe1a8176d288f4ee0", "refinement_interpretation_Tm_refine_cbce66aad24caa207d3234e4cb330c4b", - "typing_FStar.Buffer.as_seq" + "typing_Crypto.Symmetric.Bytes.sel_bytes", + "typing_FStar.Buffer.__proj__MkBuffer__item__length" ], 0 ] diff --git a/examples/low-level/crypto/TestMonotonic.fst b/examples/low-level/crypto/TestMonotonic.fst index 69d232ecb85..b4e8b6991e4 100644 --- a/examples/low-level/crypto/TestMonotonic.fst +++ b/examples/low-level/crypto/TestMonotonic.fst @@ -28,18 +28,18 @@ let rel_transitive a b c = () val init: unit -> ST (m_rref root t rel) (requires (fun m0 -> True)) - (ensures (fun m0 r m1 -> witnessed (fun m -> is_Some (m_sel m r)))) + (ensures (fun m0 r m1 -> witnessed (fun m -> Some? (m_sel m r)))) let init _ = let r = m_alloc #t #rel root (Some false) in - witness r (fun m -> is_Some (m_sel m r)); + witness r (fun m -> Some? (m_sel m r)); r val set: mr:m_rref root t rel -> STL unit - (requires (fun m0 -> witnessed (fun m -> is_Some (m_sel m mr)))) + (requires (fun m0 -> witnessed (fun m -> Some? (m_sel m mr)))) (ensures (fun _ _ _ -> witnessed (fun m -> m_sel m mr = Some true))) let set mr = m_recall mr; - testify (fun m -> is_Some (m_sel m mr)); + testify (fun m -> Some? (m_sel m mr)); let v = m_read mr in begin match v with diff --git a/examples/low-level/crypto/TestMonotonic.fst.hints b/examples/low-level/crypto/TestMonotonic.fst.hints index c597fc8809a..3f18320cdfb 100644 --- a/examples/low-level/crypto/TestMonotonic.fst.hints +++ b/examples/low-level/crypto/TestMonotonic.fst.hints @@ -25,14 +25,12 @@ 1, [ "@query", "constructor_distinct_Prims.Mktuple2", - "equality_tok_Prims.T@tok", "equation_Prims.l_True", "equation_TestMonotonic.rel", "equation_TestMonotonic.t", "false_interp", "fuel_guarded_inversion_Prims.option", "projection_inverse_Prims.Mktuple2__1", "projection_inverse_Prims.Mktuple2__2", "projection_inverse_Prims.Mktuple2__a", - "projection_inverse_Prims.Mktuple2__b", "typing_tok_Prims.T@tok", - "unit_typing" + "projection_inverse_Prims.Mktuple2__b", "unit_typing" ], 0 ], @@ -81,7 +79,6 @@ "data_elim_Prims.Some", "disc_equation_Prims.None", "disc_equation_Prims.Some", "equation_FStar.HyperHeap.sel", "equation_FStar.HyperHeap.t", "equation_FStar.HyperHeap.upd", - "equation_FStar.HyperStack.equal_stack_domains", "equation_FStar.HyperStack.hh", "equation_FStar.HyperStack.is_eternal_color", "equation_FStar.HyperStack.is_eternal_region", @@ -99,9 +96,11 @@ "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", "function_token_typing_FStar.HyperHeap.root", + "function_token_typing_FStar.HyperStack.__proj__MkRef__item__ref", "function_token_typing_Prims.bool", "function_token_typing_TestMonotonic.rel", "function_token_typing_TestMonotonic.t", + "interpretation_Tm_arrow_1e80fbabad4b25880a6efbda6c400e06", "lemma_FStar.HyperHeap.lemma_root_has_color_zero", "lemma_FStar.Map.lemma_SelUpd1", "lemma_Prims.invertOption", "pretyping_6c86c071b92797cdf01eb016249a9465", @@ -117,13 +116,14 @@ "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", - "refinement_interpretation_Tm_refine_f3541dc4dd2e5cd1d49dfd99af20aa66", + "refinement_interpretation_Tm_refine_e9be3e34b8974cf7d211692dbf125969", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", + "token_correspondence_FStar.HyperStack.__proj__MkRef__item__ref", "token_correspondence_TestMonotonic.rel", "true_interp", "typing_FStar.Heap.upd", "typing_FStar.HyperHeap.as_ref", - "typing_FStar.HyperStack.MkRef.ref", "typing_FStar.HyperStack.is_in", - "typing_FStar.Map.sel", "typing_FStar.Monotonic.RRef.as_hsref", + "typing_FStar.HyperStack.is_in", "typing_FStar.Map.sel", + "typing_FStar.Monotonic.RRef.as_hsref", "typing_FStar.Monotonic.RRef.m_sel" ], 0 @@ -255,7 +255,8 @@ "equation_FStar.Monotonic.RRef.rid", "equation_FStar.Set.subset", "equation_FStar.TSet.subset", "equation_Prims.eqtype", "equation_TestMonotonic.rel", "equation_TestMonotonic.t", - "false_interp", "fuel_guarded_inversion_Prims.option", + "false_interp", "fuel_guarded_inversion_FStar.Heap.aref", + "fuel_guarded_inversion_Prims.option", "function_token_typing_FStar.Heap.emp", "function_token_typing_FStar.Heap.heap", "function_token_typing_FStar.HyperHeap.rid", @@ -291,13 +292,14 @@ "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", "refinement_interpretation_Tm_refine_5a09de1efe4b8e150cfdaeaf95d864d4", - "refinement_interpretation_Tm_refine_d6fb17fbf40b19e4285d53d5cab914a5", "refinement_interpretation_Tm_refine_e6bdb61ef7ad9da4cb0868f5b96fc358", - "refinement_interpretation_Tm_refine_f3541dc4dd2e5cd1d49dfd99af20aa66", + "refinement_interpretation_Tm_refine_e9be3e34b8974cf7d211692dbf125969", + "refinement_interpretation_Tm_refine_f38d46289ad40d7ad5a9da2f43cecefb", "true_interp", "typing_FStar.Heap.domain", "typing_FStar.Heap.upd", "typing_FStar.HyperHeap.as_ref", "typing_FStar.HyperHeap.upd", - "typing_FStar.HyperStack.HS.h", "typing_FStar.HyperStack.MkRef.mm", - "typing_FStar.HyperStack.MkRef.ref", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__MkRef__item__mm", + "typing_FStar.HyperStack.__proj__MkRef__item__ref", "typing_FStar.HyperStack.as_aref", "typing_FStar.HyperStack.is_in", "typing_FStar.Map.domain", "typing_FStar.Map.sel", "typing_FStar.Monotonic.RRef.as_hsref", @@ -453,11 +455,12 @@ "projection_inverse_Prims.Some_a", "projection_inverse_Prims.Some_v", "refinement_interpretation_Tm_refine_0dc1829dbc3c1d1c42b7a4e9e5c89884", "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", - "refinement_interpretation_Tm_refine_4f37367c7828316b951698ec5607a402", "refinement_interpretation_Tm_refine_d023b9461e4d4c2c1260f907a1d7e4a1", - "typing_FStar.Heap.domain", "typing_FStar.HyperStack.HS.h", - "typing_FStar.HyperStack.HS.tip", "typing_FStar.HyperStack.is_in", - "typing_FStar.Map.sel" + "refinement_interpretation_Tm_refine_de8123dd3e45084cdea7d9d0e7ffb100", + "typing_FStar.Heap.domain", + "typing_FStar.HyperStack.__proj__HS__item__h", + "typing_FStar.HyperStack.__proj__HS__item__tip", + "typing_FStar.HyperStack.is_in", "typing_FStar.Map.sel" ], 0 ], diff --git a/examples/low-level/crypto/stale/Math.Curve.fst b/examples/low-level/crypto/stale/Math.Curve.fst index d52dce42f1f..795331fa0c7 100644 --- a/examples/low-level/crypto/stale/Math.Curve.fst +++ b/examples/low-level/crypto/stale/Math.Curve.fst @@ -16,14 +16,14 @@ type affine_point = | Inf | Finite: x:felem -> y:felem -> affine_point -val get_x: p:affine_point{is_Finite p} -> Tot felem +val get_x: p:affine_point{Finite? p} -> Tot felem let get_x p = Finite.x p -val get_y: p:affine_point{is_Finite p} -> Tot felem +val get_y: p:affine_point{Finite? p} -> Tot felem let get_y p = Finite.y p (* Definition of an affine point on the curve *) val on_curve: affine_point -> Tot bool -let on_curve p = (is_Inf p || (is_Finite p && (let x, y = get_x p, get_y p in (y ^^ 2) = ((x ^^ 3) ^+ (a ^* x) ^+ b)))) +let on_curve p = (Inf? p || (Finite? p && (let x, y = get_x p, get_y p in (y ^^ 2) = ((x ^^ 3) ^+ (a ^* x) ^+ b)))) type curvePoint (p:affine_point) = b2t(on_curve p) (* Type of points on the curve *) @@ -32,7 +32,7 @@ type celem = p:affine_point{curvePoint p} (* Definition of the opposite *) val neg': affine_point -> Tot affine_point let neg' p = - if is_Inf p then Inf + if Inf? p then Inf else Finite (Finite.x p) (opp (Finite.y p)) (* The opposite of a point on the curve is on the curve, proven in Coq *) @@ -48,10 +48,10 @@ val add': affine_point -> affine_point -> Tot affine_point let add' p1 p2 = if not(on_curve p1) then Inf else if not(on_curve p2) then Inf - else if is_Inf p1 then p2 - else if is_Inf p2 then p1 + else if Inf? p1 then p2 + else if Inf? p2 then p1 else ( - cut(is_Finite p1 /\ is_Finite p2); + cut(Finite? p1 /\ Finite? p2); let x1 = get_x p1 in let x2 = get_x p2 in let y1 = get_y p1 in @@ -98,8 +98,8 @@ let smul n p = (* Equality of curve elements *) assume type equal: celem -> celem -> Type assume val lemma_equal_intro: e1:celem -> e2:celem -> Lemma - (requires (Curve.is_Inf e1 /\ Curve.is_Inf e2) - \/ (Curve.is_Finite e1 /\ Curve.is_Finite e2 /\ get_x e1 == get_x e2 /\ get_y e1 == get_y e2)) + (requires (Curve.Inf? e1 /\ Curve.Inf? e2) + \/ (Curve.Finite? e1 /\ Curve.Finite? e2 /\ get_x e1 == get_x e2 /\ get_y e1 == get_y e2)) (ensures (equal e1 e2)) [SMTPatT (equal e1 e2)] assume val lemma_equal_elim: e1:celem -> e2:celem -> Lemma @@ -130,18 +130,18 @@ type point = | Affine: p:affine_point -> point | Projective: p:projective_point -> point | Jacobian: p:jacobian_point -> point -assume val to_affine: point -> Tot (p:point{is_Affine p}) -assume val to_projective: point -> Tot (p:point{is_Projective p}) -assume val to_jacobian: point -> Tot (p:point{is_Jacobian p }) +assume val to_affine: point -> Tot (p:point{Affine? p}) +assume val to_projective: point -> Tot (p:point{Projective? p}) +assume val to_jacobian: point -> Tot (p:point{Jacobian? p }) -type onCurve (p:point{is_Affine p}) = +type onCurve (p:point{Affine? p}) = (let p' = Affine.p p in curvePoint p') (* Extension of the definition to all coordinate systems *) type isOnCurve (p:point) = - (is_Affine p /\ onCurve p) - \/ (is_Projective p /\ onCurve (to_affine p)) - \/ (is_Jacobian p /\ onCurve (to_affine p)) + (Affine? p /\ onCurve p) + \/ (Projective? p /\ onCurve (to_affine p)) + \/ (Jacobian? p /\ onCurve (to_affine p)) type ec_elem = p:point{ isOnCurve p } @@ -152,8 +152,8 @@ let add_point p q = Affine (add' p' q') type eq (p1:point) (p2:point) = - (is_Inf (Affine.p (to_affine p1)) /\ is_Inf (Affine.p (to_affine p2))) \/ - (is_Finite (Affine.p (to_affine p1)) /\ is_Finite (Affine.p (to_affine p2)) /\ get_x (Affine.p (to_affine p1)) ^- get_x (Affine.p (to_affine p2)) = zero) + (Inf? (Affine.p (to_affine p1)) /\ Inf? (Affine.p (to_affine p2))) \/ + (Finite? (Affine.p (to_affine p1)) /\ Finite? (Affine.p (to_affine p2)) /\ get_x (Affine.p (to_affine p1)) ^- get_x (Affine.p (to_affine p2)) = zero) let op_Plus_Star n p = smul n p diff --git a/examples/low-level/old/huffman/huffman.fst b/examples/low-level/old/huffman/huffman.fst index b21a7dd4c9d..cddd8ff23b7 100644 --- a/examples/low-level/old/huffman/huffman.fst +++ b/examples/low-level/old/huffman/huffman.fst @@ -160,7 +160,7 @@ let is_empty l = (memread l = []) val is_singleton: l:node_list -> PureMem bool (fun m0 -> b2t (live_node_list l m0)) - (fun m0 r -> live_node_list l m0 /\ r = (is_Cons (lookupRef l m0) && + (fun m0 r -> live_node_list l m0 /\ r = (Cons? (lookupRef l m0) && Cons.tl (lookupRef l m0) = [])) let is_singleton l = match (memread l) with | _::[] -> true @@ -168,11 +168,11 @@ let is_singleton l = match (memread l) with val pop_two: l:node_list -> Mem (located node * located node) (fun m0 -> live_node_list l m0 /\ - is_Cons (lookupRef l m0) /\ - is_Cons (Cons.tl (lookupRef l m0))) + Cons? (lookupRef l m0) /\ + Cons? (Cons.tl (lookupRef l m0))) (fun m0 r m1 -> live_node_list l m0 /\ - is_Cons (lookupRef l m0) /\ - is_Cons (Cons.tl (lookupRef l m0)) /\ + Cons? (lookupRef l m0) /\ + Cons? (Cons.tl (lookupRef l m0)) /\ live_node (fst r) m1 /\ live_node (snd r) m1 /\ live_node_list l m1 /\ diff --git a/examples/low-level/old/lib/FStar.Regions.Regions.fst b/examples/low-level/old/lib/FStar.Regions.Regions.fst index 0fcefecd0a5..43993c0846b 100644 --- a/examples/low-level/old/lib/FStar.Regions.Regions.fst +++ b/examples/low-level/old/lib/FStar.Regions.Regions.fst @@ -516,7 +516,7 @@ let locIsLive v m = // (* // val writeMemAuxPreservesStail : #a:Type -> r:(lref a) -> m:smem -> v:a -> -// Lemma (requires (is_InStack (regionOf r))) +// Lemma (requires (InStack? (regionOf r))) // (ensures tail m = tail (writeMemAux r m v)) // let rec writeMemAuxPreservesStail r m v = () // *) diff --git a/examples/low-level/old/lib/FStar.Stack.fst b/examples/low-level/old/lib/FStar.Stack.fst index 3a877d50da4..7d5e041f229 100644 --- a/examples/low-level/old/lib/FStar.Stack.fst +++ b/examples/low-level/old/lib/FStar.Stack.fst @@ -12,7 +12,7 @@ let tail st = | [] -> [] | h::tl -> tl -let isNonEmpty = is_Cons +let isNonEmpty = Cons? val top : #a:Type -> l:stack a{isNonEmpty l} -> Tot a let top l = diff --git a/examples/low-level/old/unification/union-find-nospec.fst b/examples/low-level/old/unification/union-find-nospec.fst index 6be5f4a04da..12e0b295bfe 100644 --- a/examples/low-level/old/unification/union-find-nospec.fst +++ b/examples/low-level/old/unification/union-find-nospec.fst @@ -12,9 +12,9 @@ val find: x:elem -> ST elem (requires (fun _ -> True)) (ensures (fun h_0 y h_1 -> - is_Root (Heap.sel h_1 y) /\ - (forall z. is_Link (Heap.sel h_0 z) ==> is_Link (Heap.sel h_1 z)) /\ - (forall z. is_Root (Heap.sel h_0 z) ==> is_Root (Heap.sel h_1 z)))) + Root? (Heap.sel h_1 y) /\ + (forall z. Link? (Heap.sel h_0 z) ==> Link? (Heap.sel h_1 z)) /\ + (forall z. Root? (Heap.sel h_0 z) ==> Root? (Heap.sel h_1 z)))) let rec find x = match !x with | Link r -> @@ -27,7 +27,7 @@ let rec find x = val link: x:elem -> y:elem -> ST elem - (requires (fun h -> is_Root (Heap.sel h x) /\ is_Root (Heap.sel h y))) + (requires (fun h -> Root? (Heap.sel h x) /\ Root? (Heap.sel h y))) (ensures (fun _ _ _ -> True)) let link x y = if x = y then diff --git a/examples/low-level/old/unification/union-find.fst b/examples/low-level/old/unification/union-find.fst index 6edefd48c45..6d82fe272fc 100644 --- a/examples/low-level/old/unification/union-find.fst +++ b/examples/low-level/old/unification/union-find.fst @@ -139,9 +139,9 @@ val find: x:elem -> ST elem (requires (fun _ -> True)) (ensures (fun h_0 y h_1 -> - is_Root (Heap.sel h_1 y) /\ - (forall z. is_Link (Heap.sel h_0 z) ==> is_Link (Heap.sel h_1 z)) /\ - (forall z. is_Root (Heap.sel h_0 z) ==> is_Root (Heap.sel h_1 z)))) + Root? (Heap.sel h_1 y) /\ + (forall z. Link? (Heap.sel h_0 z) ==> Link? (Heap.sel h_1 z)) /\ + (forall z. Root? (Heap.sel h_0 z) ==> Root? (Heap.sel h_1 z)))) let rec find x = match !x with | Link r -> @@ -154,7 +154,7 @@ let rec find x = val link: x:elem -> y:elem -> ST elem - (requires (fun h -> is_Root (Heap.sel h x) /\ is_Root (Heap.sel h y))) + (requires (fun h -> Root? (Heap.sel h x) /\ Root? (Heap.sel h y))) (ensures (fun _ _ _ -> True)) let link x y = if x = y then diff --git a/examples/low-level/parsing/Experiment.Parsing.fst b/examples/low-level/parsing/Experiment.Parsing.fst index e5911943b49..95794ef228e 100644 --- a/examples/low-level/parsing/Experiment.Parsing.fst +++ b/examples/low-level/parsing/Experiment.Parsing.fst @@ -12,10 +12,10 @@ assume Mod_1: forall i. i % (sizeof byte) = 0 type validator = b:buffer u8 -> len:UInt32.t -> Pure (result UInt32.t) (requires (b2t(v len <= length (b)))) - (ensures (fun l -> is_Correct l ==> v (correct l) <= length (b))) + (ensures (fun l -> Correct? l ==> v (correct l) <= length (b))) type valid (b:buffer u8) (l:UInt32.t) (v:validator) = - UInt32.v l <= length b /\ is_Correct (v b l) + UInt32.v l <= length b /\ Correct? (v b l) type lsize = n:int{n = 1 \/ n = 2 \/ n = 3} type csize = n:t{v n = 1 \/ v n = 2 \/ v n = 3} @@ -46,7 +46,7 @@ let read_length b n = val vlparse: n:csize -> b:buffer u8 -> len:UInt32.t -> Pure (result UInt32.t) (requires (b2t(v len <= length b))) - (ensures (fun l -> is_Correct l ==> v (correct l) <= length (b))) + (ensures (fun l -> Correct? l ==> v (correct l) <= length (b))) let vlparse n b len = if n >^ len then Error "Too short" else diff --git a/examples/low-level/parsing/FStar.Format.fst b/examples/low-level/parsing/FStar.Format.fst index e58143761a3..780d2ddadb5 100644 --- a/examples/low-level/parsing/FStar.Format.fst +++ b/examples/low-level/parsing/FStar.Format.fst @@ -51,11 +51,11 @@ let read_length b n = type lserializer (t:Type0) = f:(t -> Tot lbytes) // The parser return the number of bytes read type lparser (#t:Type0) ($f:lserializer t) = - f:(lbytes -> Tot (result (t * UInt32.t))){forall (b:lbytes). is_Correct (f b) ==> (v (snd (correct (f b))) <= v (lb_length b) /\ v (snd (correct (f b))) > 0)} + f:(lbytes -> Tot (result (t * UInt32.t))){forall (b:lbytes). Correct? (f b) ==> (v (snd (correct (f b))) <= v (lb_length b) /\ v (snd (correct (f b))) > 0)} type inverse (#t:Type0) ($f:lserializer t ) ($g:lparser f) = (forall (x:t). g (f x) == Correct (x, lb_length (f x))) - /\ (forall (y:lbytes). is_Correct (g y) ==> (f (fst (Correct._0 (g y))) == y)) + /\ (forall (y:lbytes). Correct? (g y) ==> (f (fst (Correct._0 (g y))) == y)) noeq type lserializable (t:Type0) : Type0 = | VLSerializable: $f:lserializer t -> $g:lparser f{inverse f g} -> lserializable t @@ -178,7 +178,7 @@ let vlparse_key_share else ( let gn:buffer u8 = sub bytes 0ul 2ul in // Requires to axiomatize the parsing/serialization of machine integers more precisely - assume (is_Correct (of_seq_bytes #UInt16.t #u16 (to_seq_byte gn))); + assume (Correct? (of_seq_bytes #UInt16.t #u16 (to_seq_byte gn))); let gn = cast u16 gn in let gn = read gn 0ul in let pk_bytes = lb_offset b 2ul in diff --git a/examples/low-level/parsing/FStar.ImmBuffer.fst b/examples/low-level/parsing/FStar.ImmBuffer.fst index cd65528eea9..366fb4ea53f 100644 --- a/examples/low-level/parsing/FStar.ImmBuffer.fst +++ b/examples/low-level/parsing/FStar.ImmBuffer.fst @@ -67,8 +67,8 @@ type result 'a : Type0 = | Error of string (* Destructors for that type *) -let correct (#a:Type) (r:result a{is_Correct r}) : Tot a = match r with | Correct x -> x -let errror (#a:Type) (r:result a{is_Error r}) : Tot string = match r with | Error s -> s +let correct (#a:Type) (r:result a{Correct? r}) : Tot a = match r with | Correct x -> x +let errror (#a:Type) (r:result a{Error? r}) : Tot string = match r with | Error s -> s (* Size predicate, for types on which one can compute "sizeof" as in C *) assume type hasSize (t:Type0) : Type0 @@ -100,7 +100,7 @@ type parser (#t:sizeof_t) ($f:serializer t) = (* Type of F* types that can be serialized into sequences of bytes *) type inverse (#t:sizeof_t) ($f:serializer t) ($g:parser f) = - (forall (x:t). g (f x) == Correct x) /\ (forall (y:seq byte). is_Correct (g y) ==> (f (Correct._0 (g y))) == y) + (forall (x:t). g (f x) == Correct x) /\ (forall (y:seq byte). Correct? (g y) ==> (f (Correct._0 (g y))) == y) noeq type serializable (t:sizeof_t) : Type0 = | Serializable: $f:serializer t -> $g:parser f{inverse f g} -> serializable t @@ -135,7 +135,7 @@ let rec to_seq_bytes #t #ty s = (* Buffer of serializable types *) (* It is a "flat" representation of some structures in memory *) let buffer (#t:sizeof_t) (ty:serializable t) = - b:bytes{length_bytes b % sizeof t = 0 /\ is_Correct (of_seq_bytes #t #ty (to_seq_byte b))} + b:bytes{length_bytes b % sizeof t = 0 /\ Correct? (of_seq_bytes #t #ty (to_seq_byte b))} (* Buffer have the size of bytes (should infered using the types) *) assume BufferHasSize: forall (#ty:sizeof_t) (t:serializable ty). @@ -215,7 +215,7 @@ let cast_to_bytes (#t:sizeof_t) (#ty:serializable t) (b:buffer ty) (* Cast an appropriate "bytes" object to the corresponding "buffer " type *) let cast_to_buffer (#t:sizeof_t) (ty:serializable t) (b:bytes{length_bytes b % sizeof t = 0 - /\ is_Correct (of_seq_bytes #t #ty (to_seq_byte b))}) + /\ Correct? (of_seq_bytes #t #ty (to_seq_byte b))}) : Tot (buffer ty) = b @@ -223,7 +223,7 @@ let cast_to_buffer (#t:sizeof_t) (ty:serializable t) (b:bytes{length_bytes b % s (* Mostly for casts between native low level types (machine ints and pointers*) let cast (#t:sizeof_t) (ty:serializable t) (#t':sizeof_t) (#ty':serializable t') (b:buffer ty'{length_bytes (cast_to_bytes b) % sizeof t = 0 - /\ is_Correct (of_seq_bytes #t #ty (to_seq_byte b))}) + /\ Correct? (of_seq_bytes #t #ty (to_seq_byte b))}) : Tot (b':buffer ty) = cast_to_buffer #t ty (cast_to_bytes b) @@ -342,7 +342,7 @@ let ptr = Serializable ptr_serializer ptr_parser assume val lemma_bytes_to_buffer: b:bytes -> Lemma (length_bytes b % sizeof byte = 0 /\ Seq.length (to_seq_byte b) = length_bytes b - /\ is_Correct (of_seq_bytes #byte #u8 (to_seq_byte b))) + /\ Correct? (of_seq_bytes #byte #u8 (to_seq_byte b))) type lbytes = (| len:UInt32.t & b:buffer u8{length b >= v len} |) diff --git a/examples/low-star/buffer.fst b/examples/low-star/buffer.fst index efc0bd9c154..42410f4e3c6 100644 --- a/examples/low-star/buffer.fst +++ b/examples/low-star/buffer.fst @@ -69,7 +69,7 @@ val nth_lemma: #a:Type -> l:list a -> n:nat{ n < List.length l } -> Lemma (requires (True)) - (ensures (is_Some (List.total_nth l n))) + (ensures (Some? (List.total_nth l n))) [SMTPat (List.total_nth l n)] let rec nth_lemma l n = match n, l with @@ -86,14 +86,14 @@ type AllDistinct (m:smem) (l:list buffer) = /\ (forall (i:nat{i < List.length l}) (j:nat{j < List.length l /\ j <> i}). Distinct m (nth l i) (nth l j)) -val nth_lemma2: #a:Type -> l:list a{ is_Cons l } -> n:pos{ n < List.length l } -> +val nth_lemma2: #a:Type -> l:list a{ Cons? l } -> n:pos{ n < List.length l } -> Lemma (requires (True)) (ensures (nth l n = nth (List.Tot.tl l) (n-1))) [SMTPat (nth (List.Tot.tl l) (n-1))] let nth_lemma2 l n = () -val allDistinctLemma : m:smem -> l:list buffer{ is_Cons l } -> +val allDistinctLemma : m:smem -> l:list buffer{ Cons? l } -> Lemma (requires (AllDistinct m l)) (ensures (AllDistinct m (List.Tot.tl l))) diff --git a/examples/low-star/source.fst b/examples/low-star/source.fst index 9fd4a260ef1..e37ea3a4a07 100644 --- a/examples/low-star/source.fst +++ b/examples/low-star/source.fst @@ -27,11 +27,11 @@ type t = (*** Function experiements ***) let fst (Pair x y) = x -val proj: #a:Type -> o:option a{ is_Some o} -> Tot a +val proj: #a:Type -> o:option a{ Some? o} -> Tot a let proj o = Some.v o -val proj_int: o:option int{ is_Some o } -> Tot int +val proj_int: o:option int{ Some? o } -> Tot int let proj_int o = Some.v o diff --git a/examples/low-star/system.fst b/examples/low-star/system.fst index eed27731e80..aa2f98c25ea 100644 --- a/examples/low-star/system.fst +++ b/examples/low-star/system.fst @@ -23,7 +23,7 @@ type fd = nat * lref nat (* Input stream to be read from a file descriptor *) assume val readStreamT : f:fd -> m:smem{refIsLive (snd f) m} -> n:nat -> - Tot (s:(option (Seq.seq byte)){ is_Some s ==> Seq.length (Some.v s) <= n }) + Tot (s:(option (Seq.seq byte)){ Some? s ==> Seq.length (Some.v s) <= n }) assume val readStream : f:fd -> n:nat -> @@ -50,7 +50,7 @@ assume val read : (ensures (fun m0 n m1 -> (liveBuffer m0 b) /\ (liveBuffer m1 b) /\ (refIsLive (snd f) m0) - /\ (is_Some (readStreamT f m0 count) ==> + /\ (Some? (readStreamT f m0 count) ==> (n = Seq.length (Some.v (readStreamT f m0 count)) /\ (EqSub (sel m1 b.content) off (Some.v (readStreamT f m0 count)) 0 n))) /\ (EqSubInv (sel m0 b.content) (sel m1 b.content) off count) @@ -74,7 +74,7 @@ assume val write : (liveBuffer m0 b) /\ (liveBuffer m1 b) /\ (refIsLive (snd f) m0) /\ (refIsLive (snd f) m1) /\ (n <= b.length /\ n >= 0) (* Issue : does not get it from the returned type *) - /\ (is_Some (readStreamT f m1 n) /\ Seq.length (Some.v (readStreamT f m1 n)) = n) + /\ (Some? (readStreamT f m1 n) /\ Seq.length (Some.v (readStreamT f m1 n)) = n) /\ (EqSub (Some.v (readStreamT f m1 n)) 0 (sel m0 b.content) b.start_idx n) )) (only (snd f)) @@ -106,7 +106,7 @@ assume val readv : /\ (refIsLive (snd f) m0) /\ (forall (b:buffer{List.mem b l}). glength b.content m0 = glength b.content m1) /\ (bufferListLength m0 l = bufferListLength m1 l) - /\ (is_Some (readStreamT f m0 (bufferListLength m0 l)) ==> + /\ (Some? (readStreamT f m0 (bufferListLength m0 l)) ==> (n = Seq.length (Some.v (readStreamT f m0 (bufferListLength m0 l))) /\ (Seq.Eq (Seq.slice (bufferListContent m1 l) 0 n) (Some.v (readStreamT f m0 (bufferListLength m0 l)))))) /\ (forall (b:buffer{List.mem b l}) (i:nat{i < glength b.content m0}). @@ -129,7 +129,7 @@ assume val writev: (AllDistinct m0 l) /\ (AllDistinct m1 l) /\ (refIsLive (snd f) m0) /\ (refIsLive (snd f) m1) /\ (n <= bufferListLength m0 l /\ n >= 0) - /\ (is_Some (readStreamT f m1 n) /\ Seq.length (Some.v (readStreamT f m1 n)) = n) + /\ (Some? (readStreamT f m1 n) /\ Seq.length (Some.v (readStreamT f m1 n)) = n) /\ (Some.v (readStreamT f m1 n) = Seq.slice (bufferListContent m0 l) 0 n) )) (only (snd f)) diff --git a/examples/low-star/target.fst b/examples/low-star/target.fst index a98c34454f8..b2db2c677f2 100644 --- a/examples/low-star/target.fst +++ b/examples/low-star/target.fst @@ -39,8 +39,8 @@ type _option4 (a:Type) = | None4_ | Some4_: v:a -> _option4 a type option4 (a:Type) = - | None4: t:tag -> v:ptr (_option4 a){is_None4_ (Ptr.v v)} -> option4 a - | Some4: t:tag -> v:(ptr (_option4 a)){is_Some4_ (Ptr.v v)} -> option4 a + | None4: t:tag -> v:ptr (_option4 a){None4_? (Ptr.v v)} -> option4 a + | Some4: t:tag -> v:(ptr (_option4 a)){Some4_? (Ptr.v v)} -> option4 a (* Because the 2 constructors above are not convenient *) type Is_None (t:tag) = b2t(t = 0uy) @@ -51,8 +51,8 @@ type _option5 (a:Type) = type option5 (a:Type) = | Option5: t:tag{Is_Some t \/ Is_None t} -> - v:ptr (_option5 a){(Is_Some t ==> is_Some5_ (Ptr.v v)) - /\ (Is_None t ==> is_None5_ (Ptr.v v))} -> + v:ptr (_option5 a){(Is_Some t ==> Some5_? (Ptr.v v)) + /\ (Is_None t ==> None5_? (Ptr.v v))} -> option5 a (* Lists *) @@ -84,13 +84,13 @@ type _list4 (a:Type) = | Cons4_: hd:a -> tl:list44 a -> _list4 a and list44 (a:Type) = | List4: t:tag{Is_Nil t \/ Is_Cons t} -> - v:ptr (_list4 a) {(* (Is_Nil t <==> is_Nil4_ (Ptr.v v)) - /\ (Is_Cons t <==> is_Cons4_ (Ptr.v v))*) True } -> + v:ptr (_list4 a) {(* (Is_Nil t <==> Nil4_? (Ptr.v v)) + /\ (Is_Cons t <==> Cons4_? (Ptr.v v))*) True } -> list44 a -type list (a:Type) = l:list44 a{ (List4.t l = 0uy ==> is_Nil4_ (Ptr.v (List4.v l))) +type list (a:Type) = l:list44 a{ (List4.t l = 0uy ==> Nil4_? (Ptr.v (List4.v l))) /\ (List4.t l = 1uy ==> - (is_Cons4_ (Ptr.v (List4.v l)))) } + (Cons4_? (Ptr.v (List4.v l)))) } (* Array with immutable length (check how to works out) *) @@ -111,17 +111,17 @@ type t1 = ptr _t type t2 = | A: t:tag -> ptr _t -> t2 | B: t:tag -> ptr _t -> t2 - | C: t:tag -> v:ptr _t{is_C_ (Ptr.v v)} -> t2 - | D: t:tag -> v:ptr _t{is_D_ (Ptr.v v)} -> t2 + | C: t:tag -> v:ptr _t{C_? (Ptr.v v)} -> t2 + | D: t:tag -> v:ptr _t{D_? (Ptr.v v)} -> t2 (* Third option *) type t3 = | T: t:tag{ t = 0uy \/ t = 1uy \/ t = 2uy \/ t = 3uy } -> v:(ptr _t){ - (t=0uy ==> is_A_ (Ptr.v v)) - /\ (t=1uy ==> is_B_ (Ptr.v v)) - /\ (t=2uy ==> is_C_ (Ptr.v v)) - /\ (t=3uy ==> is_D_ (Ptr.v v)) } + (t=0uy ==> A_? (Ptr.v v)) + /\ (t=1uy ==> B_? (Ptr.v v)) + /\ (t=2uy ==> C_? (Ptr.v v)) + /\ (t=3uy ==> D_? (Ptr.v v)) } -> t3 @@ -135,9 +135,9 @@ let fst p = let res = Ptr f in res -val _proj1: #a:Type -> o:_option1 a{ is_Some1_ o} -> Tot a +val _proj1: #a:Type -> o:_option1 a{ Some1_? o} -> Tot a let _proj1 o = Some1_.v o -val proj1 : #a:Type -> o:option1 a{is_Some1_ (Ptr.v (Option1.ptr o))} -> Tot (ptr a) +val proj1 : #a:Type -> o:option1 a{Some1_? (Ptr.v (Option1.ptr o))} -> Tot (ptr a) let proj1 (Option1 ptr) = let obj = Ptr.v ptr in let p = _proj1 obj in @@ -146,7 +146,7 @@ let proj1 (Option1 ptr) = val _proj2: #a:Type -> o:_option2 a -> Tot a let _proj2 o = Some2_.v o -val proj2: #a:Type -> o:option2 a{is_Some2 o} -> Tot (ptr a) +val proj2: #a:Type -> o:option2 a{Some2? o} -> Tot (ptr a) let proj2 (Some2 ptr) = let obj = Ptr.v ptr in let p = _proj2 obj in @@ -155,23 +155,23 @@ let proj2 (Some2 ptr) = val _proj3: #a:Type -> o:_option3 a -> Tot a let _proj3 o = Some3_.v o -val proj3: #a:Type -> o:option3 a{is_Some3 o} -> Tot (ptr a) +val proj3: #a:Type -> o:option3 a{Some3? o} -> Tot (ptr a) let proj3 (Some3 _ ptr) = let obj = Ptr.v ptr in let p = _proj3 obj in let res = Ptr p in res -val _proj4: #a:Type -> o:_option4 a{is_Some4_ o} -> Tot a +val _proj4: #a:Type -> o:_option4 a{Some4_? o} -> Tot a let _proj4 o = Some4_.v o -val proj4: #a:Type -> o:option4 a{is_Some4 o} -> Tot (ptr a) +val proj4: #a:Type -> o:option4 a{Some4? o} -> Tot (ptr a) let proj4 (Some4 _ ptr) = let obj = Ptr.v ptr in let p = _proj4 obj in let res = Ptr p in res -val _proj5: #a:Type -> o:_option5 a{is_Some5_ o} -> Tot a +val _proj5: #a:Type -> o:_option5 a{Some5_? o} -> Tot a let _proj5 o = Some5_.v o val proj5: #a:Type -> o:option5 a{Is_Some (Option5.t o)} -> Tot (ptr a) let proj5 (Option5 _ ptr) = @@ -180,7 +180,7 @@ let proj5 (Option5 _ ptr) = let res = Ptr p in res -val _proj_int: o:_option5 int{ is_Some5_ o } -> Tot int +val _proj_int: o:_option5 int{ Some5_? o } -> Tot int let _proj_int o = Some5_.v o val proj_int: o:option5 int{Option5.t o = 1uy} -> Tot (ptr int) @@ -214,7 +214,7 @@ let head2 l = | 1uy -> let ptr = List4.v l in (* Assumed free *) let obj = Ptr.v ptr in - let hd = _head obj in (* Be smart and use that we know that is_Some4_ obj here *) + let hd = _head obj in (* Be smart and use that we know that Some4_? obj here *) let ptr_res = Ptr hd in let res = Option5 1uy ptr_res in res diff --git a/examples/metatheory/DbSubst.fst b/examples/metatheory/DbSubst.fst index a2a1cab3c8e..37d0674e2b5 100644 --- a/examples/metatheory/DbSubst.fst +++ b/examples/metatheory/DbSubst.fst @@ -67,7 +67,7 @@ let rec subst_zero_lem e1 e2 = | _ -> () val is_value: exp -> Tot bool -let is_value = is_EAbs +let is_value = EAbs? val step: exp -> Tot (option exp) let rec step = function diff --git a/examples/metatheory/FOmega.fst b/examples/metatheory/FOmega.fst index 1c9a9a560cc..64ae3aa2f41 100644 --- a/examples/metatheory/FOmega.fst +++ b/examples/metatheory/FOmega.fst @@ -48,7 +48,7 @@ type exp = (in this calculus doesn't interact with type substitution below) *) type esub = var -> Tot exp -type erenaming (s:esub) = (forall (x:var). is_EVar (s x)) +type erenaming (s:esub) = (forall (x:var). EVar? (s x)) val is_erenaming : s:esub -> GTot (n:int{( erenaming s ==> n=0) /\ (~(erenaming s) ==> n=1)}) @@ -60,10 +60,10 @@ let esub_inc y = EVar (y+1) val erenaming_sub_inc : unit -> Lemma (erenaming (esub_inc)) let erenaming_sub_inc _ = () -let is_evar (e:exp) : int = if is_EVar e then 0 else 1 +let is_evar (e:exp) : int = if EVar? e then 0 else 1 type tsub = var -> Tot typ -opaque type trenaming (s:tsub) = (forall (x:var). is_TVar (s x)) +opaque type trenaming (s:tsub) = (forall (x:var). TVar? (s x)) val is_trenaming : s:tsub -> GTot (n:int{( trenaming s ==> n=0) /\ (~(trenaming s) ==> n=1)}) @@ -78,10 +78,10 @@ let tsub_inc = tsub_inc_above 0 val trenaming_sub_inc : unit -> Lemma (trenaming (tsub_inc)) let trenaming_sub_inc _ = () -let is_tvar (t:typ) : int = if is_TVar t then 0 else 1 +let is_tvar (t:typ) : int = if TVar? t then 0 else 1 val tsubst : t:typ -> s:tsub -> Pure typ (requires True) - (ensures (fun t' -> trenaming s /\ is_TVar t ==> is_TVar t')) + (ensures (fun t' -> trenaming s /\ TVar? t ==> TVar? t')) (decreases %[is_tvar t; is_trenaming s; t]) let rec tsubst t s = @@ -90,7 +90,7 @@ let rec tsubst t s = | TFor k t1 | TLam k t1 -> - let tsubst_lam : y:var -> Tot (t:typ{trenaming s ==> is_TVar t}) = fun y -> + let tsubst_lam : y:var -> Tot (t:typ{trenaming s ==> TVar? t}) = fun y -> if y=0 then TVar y else (tsubst (s (y - 1)) tsub_inc) in @@ -116,7 +116,7 @@ let rec esubst_t e st = val esubst : e:exp -> s:esub -> Pure exp (requires True) - (ensures (fun e' -> erenaming s /\ is_EVar e ==> is_EVar e')) + (ensures (fun e' -> erenaming s /\ EVar? e ==> EVar? e')) (decreases %[is_evar e; is_erenaming s; e]) let rec esubst e s = @@ -124,7 +124,7 @@ let rec esubst e s = | EVar x -> s x | ELam t e1 -> - let esubst_lam : y:var -> Tot (e:exp{erenaming s ==> is_EVar e}) = fun y -> + let esubst_lam : y:var -> Tot (e:exp{erenaming s ==> EVar? e}) = fun y -> if y=0 then EVar y else (esubst (s (y - 1)) esub_inc) in ELam t (esubst e1 esubst_lam) @@ -141,7 +141,7 @@ let esubst_lam s y = else esubst (s (y-1)) esub_inc (* val esubst_lam_renaming: s:esub -> Lemma *) -(* (ensures (forall (x:var). erenaming s ==> is_EVar (esubst_lam s x))) *) +(* (ensures (forall (x:var). erenaming s ==> EVar? (esubst_lam s x))) *) (* let esubst_lam_renaming s = () *) (* Substitution extensional; trivial with the extensionality axiom *) @@ -663,7 +663,7 @@ let extend_evar g n t = type kinding : env -> typ -> knd -> Type = | KiVar : #g:env -> - a:var{is_Some (lookup_tvar g a)} -> + a:var{Some? (lookup_tvar g a)} -> kinding g (TVar a) (Some.v (lookup_tvar g a)) | KiLam : #g:env -> k:knd -> @@ -736,7 +736,7 @@ type tequiv : typ -> typ -> Type = type typing : env -> exp -> typ -> Type = | TyVar : #g:env -> - x:var{is_Some (lookup_evar g x)} -> + x:var{Some? (lookup_evar g x)} -> kinding g (Some.v (lookup_evar g x)) KTyp -> typing g (EVar x) (Some.v (lookup_evar g x)) | TyLam : #g:env -> @@ -775,7 +775,7 @@ type typing : env -> exp -> typ -> Type = typing g (ETApp e t) (tsubst_beta t t') val is_value : exp -> Tot bool -let is_value = fun e -> is_ELam e || is_EForT e +let is_value = fun e -> ELam? e || EForT? e val tappears_free_in : x:var -> t:typ -> Tot bool (decreases t) let rec tappears_free_in x t = @@ -1120,15 +1120,15 @@ let rec rlen l = match l with | RNil -> 0 | RSnoc tl _ -> rlen tl + 1 -val lookup_rl: l:rl -> x:var -> Tot (r:option typ{x < rlen l ==> is_Some r /\ - x >= rlen l ==> is_None r}) +val lookup_rl: l:rl -> x:var -> Tot (r:option typ{x < rlen l ==> Some? r /\ + x >= rlen l ==> None? r}) let rec lookup_rl l x = match l with | RNil -> None | RSnoc tl hd -> if x = 0 then Some hd else lookup_rl tl (x - 1) (* AR: why do I need this ! *) val redundant_lemma: l:rl -> x:nat -> Lemma (requires True) - (ensures (x < rlen l ==> is_Some (lookup_rl l x))) (decreases l) + (ensures (x < rlen l ==> Some? (lookup_rl l x))) (decreases l) let rec redundant_lemma l x = match l with | RNil -> () | RSnoc tl hd -> if x = 0 then () else redundant_lemma tl (x - 1) @@ -1156,9 +1156,9 @@ let rec rmap l f = match l with | RNil -> RNil | RSnoc tl hd -> RSnoc (rmap tl f) (f hd) -val rmap_lookup_lemma: l:rl -> f:(typ -> Tot typ) -> x:nat{is_Some (lookup_rl l x)} -> +val rmap_lookup_lemma: l:rl -> f:(typ -> Tot typ) -> x:nat{Some? (lookup_rl l x)} -> Lemma (requires True) - (ensures (is_Some (lookup_rl (rmap l f) x) /\ + (ensures (Some? (lookup_rl (rmap l f) x) /\ Some.v (lookup_rl (rmap l f) x) = f (Some.v (lookup_rl l x)))) let rec rmap_lookup_lemma l f x = match l with @@ -1199,7 +1199,7 @@ let commute_with_rl_lemma2 g x k_x l k y = (* AR: goes through, long time *) rmap_lookup_lemma l (tshift_up_above 0) y else let _ = extend_rl_elookup_lemma g l y in - if is_Some (lookup_evar g (y - rlen l)) then + if Some? (lookup_evar g (y - rlen l)) then let t' = Some.v (lookup_evar g (y - rlen l)) in tshifts_reordering 0 x t'; tshifts_ereordering 0 x (EVar y) @@ -1934,7 +1934,7 @@ let rec elam_typing_eq_tarr t1 e t h = (* expression with type TArr cannot be a EForT, used in progress *) opaque val tarr_not_efor: #e:exp -> #t1:typ -> #t2:typ -> h:typing empty e (TArr t1 t2) -> - Tot (u:unit{(not (is_value e)) \/ is_ELam e}) + Tot (u:unit{(not (is_value e)) \/ ELam? e}) let tarr_not_efor e t1 t2 h = match e with | EForT k e1 -> @@ -1945,7 +1945,7 @@ let tarr_not_efor e t1 t2 h = (* expression with type TFor cannot be a lambda, used in progress *) opaque val fort_not_elam: #e:exp -> #k:knd -> #t1:typ -> h:typing empty e (TFor k t1) -> - Tot (u:unit{(not (is_value e)) \/ is_EForT e}) + Tot (u:unit{(not (is_value e)) \/ EForT? e}) let fort_not_elam e k t1 h = match e with | ELam t e1 -> diff --git a/examples/metatheory/HereditarySubst.fst b/examples/metatheory/HereditarySubst.fst index 1ac2f7b3c8b..0b04561f411 100644 --- a/examples/metatheory/HereditarySubst.fst +++ b/examples/metatheory/HereditarySubst.fst @@ -148,7 +148,7 @@ type EqV = | Same : s:Ty -> EqV | Diff : y:Var -> EqV -val eq : g:Con -> s:Ty -> t:Ty -> x:Var{typing_var x g s} -> y:Var{typing_var y g t} -> Tot (r:EqV{(is_Diff r ==> typing_var (Diff.y r) (rmv g s x) t /\ y = wkv g s t x (Diff.y r)) /\ (is_Same r ==> (Same.s r = s) /\ (Same.s r = t) /\ (x = y))}) +val eq : g:Con -> s:Ty -> t:Ty -> x:Var{typing_var x g s} -> y:Var{typing_var y g t} -> Tot (r:EqV{(Diff? r ==> typing_var (Diff.y r) (rmv g s x) t /\ y = wkv g s t x (Diff.y r)) /\ (Same? r ==> (Same.s r = s) /\ (Same.s r = t) /\ (x = y))}) let rec eq g s t x y = match g with | a::g -> diff --git a/examples/metatheory/LambdaOmega.fst b/examples/metatheory/LambdaOmega.fst index 92bc7f7e865..f81d708d3f3 100644 --- a/examples/metatheory/LambdaOmega.fst +++ b/examples/metatheory/LambdaOmega.fst @@ -50,7 +50,7 @@ type exp = (in this calculus doesn't interact with type substitution below) *) type esub = var -> Tot exp -type erenaming (s:esub) = (forall (x:var). is_EVar (s x)) +type erenaming (s:esub) = (forall (x:var). EVar? (s x)) val is_erenaming : s:esub -> GTot (n:int{( erenaming s ==> n=0) /\ (~(erenaming s) ==> n=1)}) @@ -59,13 +59,13 @@ let is_erenaming s = (if strong_excluded_middle (erenaming s) then 0 else 1) val esub_inc : var -> Tot exp let esub_inc y = EVar (y+1) -let is_evar (e:exp) : int = if is_EVar e then 0 else 1 +let is_evar (e:exp) : int = if EVar? e then 0 else 1 val esubst : s:esub -> e:exp -> Pure exp (requires True) - (ensures (fun e' -> erenaming s /\ is_EVar e ==> is_EVar e')) + (ensures (fun e' -> erenaming s /\ EVar? e ==> EVar? e')) (decreases %[is_evar e; is_erenaming s; 1; e]) -val esub_lam: s:esub -> x:var -> Tot (e:exp{ erenaming s ==> is_EVar e}) +val esub_lam: s:esub -> x:var -> Tot (e:exp{ erenaming s ==> EVar? e}) (decreases %[1;is_erenaming s; 0; EVar 0]) let rec esubst s e = @@ -78,7 +78,7 @@ and esub_lam s = fun y -> else esubst esub_inc (s (y-1)) val esub_lam_renaming: s:esub -> Lemma - (ensures (forall (x:var). erenaming s ==> is_EVar (esub_lam s x))) + (ensures (forall (x:var). erenaming s ==> EVar? (esub_lam s x))) let esub_lam_renaming s = () (* Substitution extensional; trivial with the extensionality axiom *) @@ -113,7 +113,7 @@ let esubst_beta e = esubst (esub_beta e) (via confluence); so we can still hope we can do better for TinyF*.*) type tsub = var -> Tot typ -type trenaming (s:tsub) = (forall (x:var). is_TVar (s x)) +type trenaming (s:tsub) = (forall (x:var). TVar? (s x)) val is_trenaming : s:tsub -> GTot (n:int{( trenaming s ==> n=0) /\ (~(trenaming s) ==> n=1)}) @@ -128,17 +128,17 @@ let tsub_inc = tsub_inc_above 0 val trenaming_sub_inc : unit -> Lemma (trenaming (tsub_inc)) let trenaming_sub_inc _ = () -let is_tvar (t:typ) : int = if is_TVar t then 0 else 1 +let is_tvar (t:typ) : int = if TVar? t then 0 else 1 val tsubst : s:tsub -> t:typ -> Pure typ (requires True) - (ensures (fun t' -> trenaming s /\ is_TVar t ==> is_TVar t')) + (ensures (fun t' -> trenaming s /\ TVar? t ==> TVar? t')) (decreases %[is_tvar t; is_trenaming s; t]) let rec tsubst s t = match t with | TVar x -> s x | TLam k t1 -> - let tsub_lam : y:var -> Tot (t:typ{trenaming s ==> is_TVar t}) = + let tsub_lam : y:var -> Tot (t:typ{trenaming s ==> TVar? t}) = fun y -> if y=0 then TVar y else (tsubst tsub_inc (s (y-1))) in TLam k (tsubst tsub_lam t1) @@ -174,7 +174,7 @@ val tsub_comp_inc : s:tsub -> x:var -> let tsub_comp_inc s x = () val tsub_lam_renaming: s:tsub -> Lemma - (ensures (forall (x:var). trenaming s ==> is_TVar (tsub_lam s x))) + (ensures (forall (x:var). trenaming s ==> TVar? (tsub_lam s x))) let tsub_lam_renaming s = () val tsubst_comp : s1:tsub -> s2:tsub -> t:typ -> Lemma @@ -316,10 +316,10 @@ noeq type env = | MkEnv: a:a_env -> x:x_env -> env val lookup_tvar: env -> nat -> Tot (option knd) -let lookup_tvar g n = MkEnv.a g n +let lookup_tvar g n = MkEnv?.a g n val lookup_evar: env -> nat -> Tot (option typ) -let lookup_evar g n = MkEnv.x g n +let lookup_evar g n = MkEnv?.x g n val empty: env let empty = MkEnv empty_a empty_x @@ -348,8 +348,8 @@ let extend_evar g n t = noeq type kinding : env -> typ -> knd -> Type = | KiVar : #g:env -> - a:var{is_Some (lookup_tvar g a)} -> - kinding g (TVar a) (Some.v (lookup_tvar g a)) + a:var{Some? (lookup_tvar g a)} -> + kinding g (TVar a) (Some?.v (lookup_tvar g a)) | KiLam : #g:env -> k:knd -> #t:typ -> @@ -410,9 +410,9 @@ type tequiv : typ -> typ -> Type = noeq type typing : env -> exp -> typ -> Type = | TyVar : #g:env -> - x:var{is_Some (lookup_evar g x)} -> - $hk:kinding g (Some.v (lookup_evar g x)) KTyp -> - typing g (EVar x) (Some.v (lookup_evar g x)) + x:var{Some? (lookup_evar g x)} -> + $hk:kinding g (Some?.v (lookup_evar g x)) KTyp -> + typing g (EVar x) (Some?.v (lookup_evar g x)) | TyLam : #g:env -> t:typ -> #e1:exp -> @@ -440,7 +440,7 @@ noeq type typing : env -> exp -> typ -> Type = (* Progress proof *) val is_value : exp -> Tot bool -let is_value = is_ELam +let is_value = ELam? irreducible val progress : #e:exp -> #t:typ -> h:typing empty e t -> Pure (cexists (fun e' -> step e e')) @@ -480,10 +480,10 @@ let rec tcontext_invariance #t #g #k h g' = | KiApp h1 h2 -> KiApp (tcontext_invariance h1 g') (tcontext_invariance h2 g') | KiArr h1 h2 -> KiArr (tcontext_invariance h1 g') (tcontext_invariance h2 g') (* CH: this doesn't directly follow from functional extensionality, - because (MkEnv.x g) and (MkEnv.x g') are completely unrelated; + because (MkEnv?.x g) and (MkEnv?.x g') are completely unrelated; this is just because we pass this useless argument to kinding. *) irreducible val kinding_extensional: #g:env -> #t:typ -> #k:knd -> h:(kinding g t k) -> - g':env{feq (MkEnv.a g) (MkEnv.a g')} -> + g':env{feq (MkEnv?.a g) (MkEnv?.a g')} -> Tot (kinding g' t k) (decreases h) let rec kinding_extensional #g #t #k h g' = match h with @@ -547,7 +547,7 @@ let rec typing_to_kinding #g #e #t h = match h with | TyLam t' hk h1 -> KiArr hk (kinding_strengthening_ebnd g 0 t' (typing_to_kinding h1)) | TyApp #g #e1 #e2 #t1 #t2 h1 h2 -> - Conj.h2 (kinding_inversion_arrow #g #t1 #t2 (typing_to_kinding h1)) + Conj?.h2 (kinding_inversion_arrow #g #t1 #t2 (typing_to_kinding h1)) | TyEqu h1 eq hk -> hk (* this folows from functional extensionality *) @@ -608,18 +608,18 @@ let rec tequiv_tshift #t1 #t2 h x = | EqArr h1 h2 -> EqArr (tequiv_tshift h1 x) (tequiv_tshift h2 x) val is_var : exp -> Tot(nat) -let is_var e = if is_EVar e then 0 else 1 -type renaming (s:esub) = (forall (x:var). is_EVar (s x)) +let is_var e = if EVar? e then 0 else 1 +type renaming (s:esub) = (forall (x:var). EVar? (s x)) val is_renaming : s:esub -> GTot (n:int{ (renaming s ==> n=0) /\ (~(renaming s) ==> n=1)}) let is_renaming s = (if strong_excluded_middle (renaming s) then 0 else 1) type subst_typing (s:esub) (g1:env) (g2:env) = - f:(x:var{is_Some (lookup_evar g1 x)} -> - kinding g1 (Some.v (lookup_evar g1 x)) KTyp -> - Tot(typing g2 (s x) (Some.v (lookup_evar g1 x))) - ){feq (MkEnv.a g1) (MkEnv.a g2)} + f:(x:var{Some? (lookup_evar g1 x)} -> + kinding g1 (Some?.v (lookup_evar g1 x)) KTyp -> + Tot(typing g2 (s x) (Some?.v (lookup_evar g1 x))) + ){feq (MkEnv?.a g1) (MkEnv?.a g2)} irreducible val substitution : #g1:env -> #e:exp -> #t:typ -> s:esub -> #g2:env -> @@ -641,7 +641,7 @@ let rec substitution #g1 #e #t s #g2 h1 hs = if y = 0 then TyVar y (kinding_extensional hkindg1 (extend_evar g2 0 tlam)) else let hgamma2 - (* : typing g2 (s (y-1)) (Some.v (lookup_evar g1 (y-1))) + (* : typing g2 (s (y-1)) (Some?.v (lookup_evar g1 (y-1))) -- this annotation doesn't help fix inference problem below *) = hs (y - 1) (kinding_extensional hkindg1 g1) in (* XXX before universes this used to work without implicits @@ -649,7 +649,7 @@ let rec substitution #g1 #e #t s #g2 h1 hs = (* substitution esub_inc hgamma2 hs'' *) (* Failed to verify implicit argument: Subtyping check failed; expected type LambdaOmega.var; got type Prims.int [2 times] *) - substitution #_ #(s (y-1)) #(Some.v (lookup_evar g1 (y-1))) + substitution #_ #(s (y-1)) #(Some?.v (lookup_evar g1 (y-1))) esub_inc #_ hgamma2 hs'' in (esub_lam_hoist tlam ebody s; TyLam tlam (kinding_extensional hkind g2) @@ -874,46 +874,46 @@ let rec tred_diamond #s #t #u h1 h2 = h22: tred s2' u2' s1' = (TLam k s1); s2' = s2 *) (* AR: does not work without this type annotation *) - let h21:(tred (TLam.t s1') (TLam.t lu1')) = + let h21:(tred (TLam?.t s1') (TLam?.t lu1')) = match h21 with | TrLam _ h' -> h' - | TrRefl _ -> TrRefl (TLam.t s1') in + | TrRefl _ -> TrRefl (TLam?.t s1') in (* magic() (\* XXX *\) *) - let ExIntro v1 (Conj p1a p1b) = tred_diamond #(TLam.t s1') #_ #(TLam.t lu1') h11 h21 in + let ExIntro v1 (Conj p1a p1b) = tred_diamond #(TLam?.t s1') #_ #(TLam?.t lu1') h11 h21 in (* XXX: tred_diamond h11 h21 (#580) This used to work before universes but now fails: Failed to verify implicit argument: Subtyping check failed; expected type - (uu___#3285:LambdaOmega.typ{(Prims.b2t (LambdaOmega.is_TLam uu___@0))} + (uu___#3285:LambdaOmega.typ{(Prims.b2t (LambdaOmega.TLam? uu___@0))} ); got type LambdaOmega.typ *) let ExIntro v2 (Conj p2a p2b) = tred_diamond h12 h22 in let v = tsubst_beta v2 v1 in - ExIntro v (Conj (subst_of_tred_tred 0 p2a p1a) (TrBeta #(TLam.t lu1') #_ #_ #_ k p1b p2b)) + ExIntro v (Conj (subst_of_tred_tred 0 p2a p1a) (TrBeta #(TLam?.t lu1') #_ #_ #_ k p1b p2b)) (* XXX: TrBeta k p1b p2b: Failed to verify implicit argument: Subtyping check failed; expected type (uu___#3285:LambdaOmega.typ{(Prims.b2t - (LambdaOmega.is_TLam uu___@0))}); got type LambdaOmega.typ*) + (LambdaOmega.TLam? uu___@0))}); got type LambdaOmega.typ*) | MkLTup (TrApp #s1' #s2' #lu1' #u2' h21 h22) (TrBeta #s1 #s2 #t1' #t2' k h11 h12) -> let ExIntro v1 (Conj p1 p2) = tred_diamond h21 (TrLam k h11) in let ExIntro v2 (Conj p3 p4) = tred_diamond h22 h12 in - let h_body:(tred (TLam.t lu1') (TLam.t v1)) = + let h_body:(tred (TLam?.t lu1') (TLam?.t v1)) = match p1 with | TrLam _ h' -> h' - | TrRefl _ -> TrRefl (TLam.t lu1') in - let h_body2:(tred t1' (TLam.t v1)) = + | TrRefl _ -> TrRefl (TLam?.t lu1') in + let h_body2:(tred t1' (TLam?.t v1)) = match p2 with | TrLam _ h' -> h' | TrRefl _ -> TrRefl t1' in - ExIntro (tsubst_beta v2 (TLam.t v1)) - (Conj (TrBeta #(TLam.t lu1') #_ #_ #_ k h_body p3) + ExIntro (tsubst_beta v2 (TLam?.t v1)) + (Conj (TrBeta #(TLam?.t lu1') #_ #_ #_ k h_body p3) (subst_of_tred_tred 0 p4 h_body2)) (* XXX (#580): (TrBeta k h_body p3) *) (* Failed to verify implicit argument: Subtyping check failed; expected type (uu___#3285:LambdaOmega.typ{(Prims.b2t - (LambdaOmega.is_TLam uu___@0))}); got type LambdaOmega.typ *) + (LambdaOmega.TLam? uu___@0))}); got type LambdaOmega.typ *) type tred_star: typ -> typ -> Type = | TsRefl : t:typ -> @@ -1163,7 +1163,7 @@ irreducible val inversion_elam_typing : #g:env -> s1:typ -> e:exp -> (kinding g s1 KTyp)) let inversion_elam_typing #g s1 e t1 t2 h = inversion_elam s1 e t1 t2 h (EqRefl (TArr t1 t2)) - (Conj.h2 (kinding_inversion_arrow #g #t1 #t2 (typing_to_kinding h))) + (Conj?.h2 (kinding_inversion_arrow #g #t1 #t2 (typing_to_kinding h))) (* Type preservation *) irreducible val preservation : #e:exp -> #e':exp -> hs:step e e' -> diff --git a/examples/metatheory/MicroFStar.fst b/examples/metatheory/MicroFStar.fst index 0f5987dbd3c..854a7b07af6 100644 --- a/examples/metatheory/MicroFStar.fst +++ b/examples/metatheory/MicroFStar.fst @@ -199,9 +199,9 @@ let rec is_value e = | EApp e11 e12 -> is_value e12 && (match e11 with - | EConst c -> (is_EcFixPure c || is_EcUpd c) + | EConst c -> (EcFixPure? c || EcUpd? c) | _ -> false) - | EConst c -> (is_EcFixPure c || is_EcFixOmega c || is_EcUpd c || is_EcSel c || is_EcAssign c) + | EConst c -> (EcFixPure? c || EcFixOmega? c || EcUpd? c || EcSel? c || EcAssign? c) | _ -> false) type value = e:exp{is_value e} @@ -278,7 +278,7 @@ and prove some properties on it*) type esub = var -> Tot exp -type erenaming (s:esub) = (forall (x:var). is_EVar (s x)) +type erenaming (s:esub) = (forall (x:var). EVar? (s x)) opaque val is_erenaming : s:esub -> GTot (n:int{( erenaming s ==> n=0) /\ (~(erenaming s) ==> n=1)}) @@ -306,7 +306,7 @@ val esub_inc2 : var -> Tot exp (* let esub_inc2 = esub_inc_gen 2 -- working around #311 *) let esub_inc2 x = esub_inc_gen 2 x -let is_evar (e:exp) : int = if is_EVar e then 0 else 1 +let is_evar (e:exp) : int = if EVar? e then 0 else 1 val omap : ('a -> Tot 'b) -> option 'a -> Tot (option 'b) let omap f o = @@ -320,7 +320,7 @@ let omap f o = (****************************) type tsub = var -> Tot typ -opaque type trenaming (s:tsub) = (forall (x:var). is_TVar (s x)) +opaque type trenaming (s:tsub) = (forall (x:var). TVar? (s x)) val is_trenaming : s:tsub -> GTot (n:int{( trenaming s ==> n=0) /\ (~(trenaming s) ==> n=1)}) @@ -343,7 +343,7 @@ val tsub_id :tsub let tsub_id = fun x -> TVar x -let is_tvar (t:typ) : int = if is_TVar t then 0 else 1 +let is_tvar (t:typ) : int = if TVar? t then 0 else 1 (********************************) (* Global substitution function *) @@ -373,12 +373,12 @@ let sub_tdec = Sub esub_id tsub_dec let sub_id = Sub esub_id tsub_id val esubst : s:sub -> e:exp -> Pure exp (requires True) - (ensures (fun e' -> renaming s /\ is_EVar e ==> is_EVar e')) + (ensures (fun e' -> renaming s /\ EVar? e ==> EVar? e')) (decreases %[is_evar e; is_renaming s;1; e]) val ecsubst : s:sub -> ec:econst -> Tot econst (decreases %[1; is_renaming s; 1; ec]) val tsubst : s:sub -> t:typ -> Pure typ (requires True) - (ensures (fun t' -> renaming s /\ is_TVar t ==> is_TVar t')) + (ensures (fun t' -> renaming s /\ TVar? t ==> TVar? t')) (decreases %[is_tvar t; is_renaming s;1; t]) val tcsubst : s:sub -> tc: tconst -> Tot tconst (decreases %[1; is_renaming s; 1; tc]) @@ -392,19 +392,19 @@ val sub_tlam : s:sub -> Tot(r:sub{renaming s ==> renaming r}) (decreases %[1; is_renaming s; 0; EVar 0]) let rec sub_elam s = -let esub_elam : x:var -> Tot(e:exp{renaming s ==> is_EVar e}) = +let esub_elam : x:var -> Tot(e:exp{renaming s ==> EVar? e}) = fun x -> if x = 0 then EVar x else esubst sub_einc (Sub.es s (x-1)) in -let tsub_elam : x:var -> Tot(t:typ{renaming s ==> is_TVar t}) = +let tsub_elam : x:var -> Tot(t:typ{renaming s ==> TVar? t}) = fun a -> tsubst sub_einc (Sub.ts s a) in Sub esub_elam tsub_elam and sub_tlam s = -let esub_tlam : x:var -> Tot(e:exp{renaming s ==> is_EVar e}) = +let esub_tlam : x:var -> Tot(e:exp{renaming s ==> EVar? e}) = fun x -> esubst sub_tinc (Sub.es s x) in -let tsub_tlam : a:var -> Tot(t:typ{renaming s ==> is_TVar t}) = +let tsub_tlam : a:var -> Tot(t:typ{renaming s ==> TVar? t}) = fun a -> if a = 0 then TVar a else tsubst sub_tinc (Sub.ts s (a-1)) in @@ -1464,14 +1464,14 @@ let head_const_eq ot1 ot2 = | _ , _ -> ot1 = ot2 val is_hnf : typ -> Tot bool -let is_hnf t = is_TArr t || is_Some (head_const t) +let is_hnf t = TArr? t || Some? (head_const t) val head_eq : t1:typ{is_hnf t1} -> t2:typ{is_hnf t2} -> Tot bool let head_eq t1 t2 = - if (is_TArr t1 && is_TArr t2) then + if (TArr? t1 && TArr? t2) then Cmp.m (TArr.c t1) = Cmp.m (TArr.c t2) else - is_Some (head_const t1) && head_const_eq (head_const t1) (head_const t2) + Some? (head_const t1) && head_const_eq (head_const t1) (head_const t2) val econst_eq : ec1 : econst -> ec2 : econst -> Tot bool let econst_eq ec1 ec2 = @@ -1757,7 +1757,7 @@ let get_pullback g t g' k' = //{{{ type typing : env -> exp -> cmp -> Type = -| TyVar : #g:env -> x:var{is_Some (lookup_evar g x)} -> +| TyVar : #g:env -> x:var{Some? (lookup_evar g x)} -> typing g (EVar x) (tot (Some.v (lookup_evar g x))) | TyConst : g:env -> c:econst -> ecwf g c -> @@ -1800,8 +1800,8 @@ type typing : env -> exp -> cmp -> Type = #t':typ -> #wp:typ -> #wp1:typ -> #wp2:typ -> =ht1:typing g e1 (Cmp m (TArr t (Cmp m t' wp)) wp1) -> =ht2:typing g e2 (Cmp m t wp2) -> - =htot:option (typing g e2 (tot t)){teappears 0 t' ==> is_Some htot} -> - =hk:option (kinding g (teshd t') KType){not (teappears 0 t') ==> is_Some hk} -> + =htot:option (typing g e2 (tot t)){teappears 0 t' ==> Some? htot} -> + =hk:option (kinding g (teshd t') KType){not (teappears 0 t') ==> Some? hk} -> typing g (EApp e1 e2) (Cmp m (tsubst (sub_ebeta e2) t') (tyapp_wp m e2 t t' wp wp1 wp2)) | TyRet : #g:env -> #e:exp -> t:typ -> @@ -1855,7 +1855,7 @@ and tcwf : g:env -> tc:tconst -> Type = | WFTcEqT : #g:env -> #k:knd -> kwf g k -> tcwf g (TcEqT k) -| WFTcOther : g:env -> tc:tconst{not(is_TcForallT tc) && not(is_TcEqT tc)} -> +| WFTcOther : g:env -> tc:tconst{not(TcForallT? tc) && not(TcEqT? tc)} -> tcwf g tc and ecwf : g:env -> ec:econst -> Type = | WFEcFixPure : #g:env -> #tx : typ -> #t':typ -> #t'':typ -> #wp:typ -> @@ -1869,11 +1869,11 @@ and ecwf : g:env -> ec:econst -> Type = kinding g t' (KTArr tx KType) -> kinding g wp (KTArr tx (k_all (TEApp (tesh t') (EVar 0)))) -> ecwf g (EcFixOmega tx t' wp) -| WFEcOther : g:env -> ec:econst{not(is_EcFixPure ec) && not(is_EcFixOmega ec)} -> +| WFEcOther : g:env -> ec:econst{not(EcFixPure? ec) && not(EcFixOmega? ec)} -> ecwf g ec and kinding : g:env -> t : typ -> k:knd -> Type = -| KVar : #g:env -> x:var{is_Some (lookup_tvar g x)} -> +| KVar : #g:env -> x:var{Some? (lookup_tvar g x)} -> kinding g (TVar x) (Some.v (lookup_tvar g x)) | KConst : #g:env -> #c:tconst -> @@ -3009,10 +3009,10 @@ Lemma (esubst s (ELam t1 ebody) = ELam (tsubst s t1) (esubst (sub_elam s) ebody) let subst_on_elam s t1 ebody = admit() -val subst_preserves_tarrow : s:sub -> t:typ -> Lemma (is_TArr t ==> is_TArr (tsubst s t)) +val subst_preserves_tarrow : s:sub -> t:typ -> Lemma (TArr? t ==> TArr? (tsubst s t)) let subst_preserves_tarrow s t = () -val subst_preserves_head_const : s:sub -> t:typ -> Lemma (is_Some (head_const t) ==> is_Some (head_const (tsubst s t))) +val subst_preserves_head_const : s:sub -> t:typ -> Lemma (Some? (head_const t) ==> Some? (head_const (tsubst s t))) let rec subst_preserves_head_const s t = match t with | TConst tc -> () @@ -3024,7 +3024,7 @@ val subst_on_hnf : s:sub -> t:typ -> Lemma (requires (is_hnf t)) (ensures (is_hnf (tsubst s t) )) let subst_on_hnf s t = subst_preserves_tarrow s t; subst_preserves_head_const s t -val subst_on_head_const : s:sub -> t:typ -> Lemma (requires (is_Some (head_const t))) (ensures (head_const (tsubst s t) = omap (tcsubst s) (head_const t))) +val subst_on_head_const : s:sub -> t:typ -> Lemma (requires (Some? (head_const t))) (ensures (head_const (tsubst s t) = omap (tcsubst s) (head_const t))) let rec subst_on_head_const s t = match t with | TConst tc -> () @@ -3036,9 +3036,9 @@ let subst_preserves_head_eq s t1 t2 = (* SF : this proof is working but is slow. Maybe improve it later *) admit()(* subst_on_hnf s t1; subst_on_hnf s t2; -if (is_TArr t1 && is_TArr t2) then () -else if (is_TArr t1 && not (is_TArr t2)) then () -else if (not (is_TArr t1) && is_TArr t2) then () +if (TArr? t1 && TArr? t2) then () +else if (TArr? t1 && not (TArr? t2)) then () +else if (not (TArr? t1) && TArr? t2) then () else (subst_on_head_const s t1; subst_on_head_const s t2) *) @@ -3168,24 +3168,24 @@ match hs with type subst_typing : s:sub -> g1:env -> g2:env -> Type = | SubstTyping : s:sub-> g1:env -> g2:env -> - ef:(x:var{is_Some (lookup_evar g1 x)} -> + ef:(x:var{Some? (lookup_evar g1 x)} -> Tot(typing g2 (Sub.es s x) (tot (tsubst s (Some.v (lookup_evar g1 x)))))) -> - tf:(a:var{is_Some (lookup_tvar g1 a)} -> + tf:(a:var{Some? (lookup_tvar g1 a)} -> Tot(kinding g2 (Sub.ts s a) (ksubst s (Some.v (lookup_tvar g1 a))))) -> subst_typing s g1 g2 | RenamingTyping : s:sub -> g1:env -> g2:env -> - ef:(x:var{is_Some (lookup_evar g1 x)} -> - Tot(hr:typing g2 (Sub.es s x) (tot (tsubst s (Some.v (lookup_evar g1 x)))){is_TyVar hr})) -> + ef:(x:var{Some? (lookup_evar g1 x)} -> + Tot(hr:typing g2 (Sub.es s x) (tot (tsubst s (Some.v (lookup_evar g1 x)))){TyVar? hr})) -> - tf:(a:var{is_Some (lookup_tvar g1 a)} -> - Tot(hr:kinding g2 (Sub.ts s a) (ksubst s (Some.v (lookup_tvar g1 a))){is_KVar hr})) -> + tf:(a:var{Some? (lookup_tvar g1 a)} -> + Tot(hr:kinding g2 (Sub.ts s a) (ksubst s (Some.v (lookup_tvar g1 a))){KVar? hr})) -> subst_typing s g1 g2 (*I wanted to rewrite the substitution lemma in a 'is_renaming' style (so without the RenamingTyping constructor) but I was not able to make it work*) (* CH: can't make this opaque or SMT will loop forever! *) -val is_renaming_typing : #s:sub -> #g1:env -> #g2:env -> hs:subst_typing s g1 g2 -> Tot (r:nat{is_RenamingTyping hs ==> r = 0 /\ is_SubstTyping hs ==> r = 1}) -let is_renaming_typing s g1 g2 hs = if (is_RenamingTyping hs) then 0 else 1 +val is_renaming_typing : #s:sub -> #g1:env -> #g2:env -> hs:subst_typing s g1 g2 -> Tot (r:nat{RenamingTyping? hs ==> r = 0 /\ SubstTyping? hs ==> r = 1}) +let is_renaming_typing s g1 g2 hs = if (RenamingTyping? hs) then 0 else 1 //}}} @@ -3194,7 +3194,7 @@ let is_renaming_typing s g1 g2 hs = if (is_RenamingTyping hs) then 0 else 1 (*****************************) //{{{ opaque val hs_sub_einc : g:env -> t:typ -> -Tot(r:subst_typing sub_einc g (eextend t g){is_RenamingTyping r}) +Tot(r:subst_typing sub_einc g (eextend t g){RenamingTyping? r}) let hs_sub_einc g t = let temp : subst_typing sub_einc g (eextend t g) = RenamingTyping sub_einc g (eextend t g) (fun x -> TyVar (x+1) @@ -3202,12 +3202,12 @@ let hs_sub_einc g t = (fun a -> KVar a ) in temp opaque val hs_sub_tinc : g:env -> k:knd -> - Tot(r:subst_typing sub_tinc g (textend k g){is_RenamingTyping r}) + Tot(r:subst_typing sub_tinc g (textend k g){RenamingTyping? r}) let hs_sub_tinc g k = RenamingTyping sub_tinc g (textend k g) (fun x -> TyVar x) (fun a -> KVar (a+1)) -opaque val hs_sub_id : g:env -> Tot (r:subst_typing sub_id g g{is_RenamingTyping r}) +opaque val hs_sub_id : g:env -> Tot (r:subst_typing sub_id g g{RenamingTyping? r}) let hs_sub_id g = RenamingTyping sub_id g g (fun x -> tsubst_with_sub_id (Some.v (lookup_evar g x)); TyVar x) (fun a -> ksubst_with_sub_id (Some.v (lookup_tvar g a)); KVar a) @@ -3235,7 +3235,7 @@ SubstTyping (sub_tbeta t) (textend k g) g ) (* -opaque val compose_with_renaming_arrow : g1 : env -> g2 : env -> g3 : env -> s12 : sub -> s23 : sub -> hs12 : subst_typing s12 g1 g2{ is_RenamingTyping hs12} -> hs23 : subst_typing s23 g2 g3 -> Tot (hr : subst_typing (sub_comp s23 s12) g1 g3) +opaque val compose_with_renaming_arrow : g1 : env -> g2 : env -> g3 : env -> s12 : sub -> s23 : sub -> hs12 : subst_typing s12 g1 g2{ RenamingTyping? hs12} -> hs23 : subst_typing s23 g2 g3 -> Tot (hr : subst_typing (sub_comp s23 s12) g1 g3) let compose_with_renaming_arrow g1 g2 g3 s12 s23 hs12 hs23 = let RenamingTyping _ _ _ ef12 tf12 = hs12 in match hs23 with @@ -3263,10 +3263,10 @@ SubstTyping (sub_comp s23 s12) g1 g3 //{{{ val is_tyvar : #g:env -> #e:exp -> #t:cmp -> ht:typing g e t -> Tot nat -let is_tyvar g e t ht = if is_TyVar ht then 0 else 1 +let is_tyvar g e t ht = if TyVar? ht then 0 else 1 val is_kvar : #g : env -> #t:typ -> #k:knd -> hk : kinding g t k -> Tot nat -let is_kvar g t k hk = if is_KVar hk then 0 else 1 +let is_kvar g t k hk = if KVar? hk then 0 else 1 (* CH: this doesn't always help, on the the contrary #set-options "--split_cases 1" *) @@ -3278,7 +3278,7 @@ let is_kvar g t k hk = if is_KVar hk then 0 else 1 opaque val typing_substitution : #g1:env -> #e:exp -> #c:cmp -> s:sub -> #g2:env -> h1:typing g1 e c -> hs:subst_typing s g1 g2 -> - Tot (hr:typing g2 (esubst s e) (csubst s c) {is_RenamingTyping hs /\ is_TyVar h1 ==> is_TyVar hr} ) + Tot (hr:typing g2 (esubst s e) (csubst s c) {RenamingTyping? hs /\ TyVar? h1 ==> TyVar? hr} ) (decreases %[is_tyvar h1; is_renaming_typing hs; 1;h1]) opaque val scmp_substitution : #g1:env -> #c1:cmp -> #c2:cmp -> s:sub -> #g2:env -> h1:scmp g1 c1 c2 -> @@ -3303,7 +3303,7 @@ opaque val ecwf_substitution : #g1:env -> #ec:econst -> s:sub -> #g2:env -> opaque val kinding_substitution : #g1:env -> #t:typ -> #k:knd -> s:sub -> #g2:env -> h1:kinding g1 t k -> hs:subst_typing s g1 g2 -> - Tot (hr:kinding g2 (tsubst s t) (ksubst s k){is_RenamingTyping hs /\ is_KVar h1 ==> is_KVar hr}) + Tot (hr:kinding g2 (tsubst s t) (ksubst s k){RenamingTyping? hs /\ KVar? h1 ==> KVar? hr}) (decreases %[is_kvar h1; is_renaming_typing hs; 1; h1]) opaque val skinding_substitution : #g1:env -> #k1:knd -> #k2:knd -> s:sub -> #g2:env -> h1:skinding g1 k1 k2 -> @@ -3324,11 +3324,11 @@ opaque val validity_substitution : #g1:env -> #t:typ -> s:sub -> #g2:env -> Try the proof for each case with '~>' *) opaque val elam_hs : #g1:env -> s:sub -> #g2:env -> t:typ -> hs:subst_typing s g1 g2 -> - Tot (hr:subst_typing (sub_elam s) (eextend t g1) (eextend (tsubst s t) g2){is_RenamingTyping hs ==> is_RenamingTyping hr}) + Tot (hr:subst_typing (sub_elam s) (eextend t g1) (eextend (tsubst s t) g2){RenamingTyping? hs ==> RenamingTyping? hr}) (decreases %[1;is_renaming_typing hs; 0; EVar 0]) opaque val tlam_hs : #g1:env -> s:sub -> #g2:env -> k:knd -> hs:subst_typing s g1 g2 -> - Tot (hr:subst_typing (sub_tlam s) (textend k g1) (textend (ksubst s k) g2){is_RenamingTyping hs ==> is_RenamingTyping hr}) + Tot (hr:subst_typing (sub_tlam s) (textend k g1) (textend (ksubst s k) g2){RenamingTyping? hs ==> RenamingTyping? hr}) (decreases %[1;is_renaming_typing hs; 0; TVar 0]) let rec typing_substitution g1 e c s g2 h1 hs = magic() (* CH: this started failing 2015-08-26, but was very flaky before too @@ -3385,14 +3385,14 @@ let ht2g2 : typing g2 (esubst s e2) (Cmp m (tsubst s t) (tsubst s wp2)) = typin if (teappears 0 t') then ( tsubst_on_eappears 0 (sub_elam s) t'; - let htotg2 : ht: option(typing g2 (esubst s e2) (tot (tsubst s t))){is_Some ht} = subst_on_tot s t; let Some htotv = htot in Some (typing_substitution #g1 #e2 #(tot t) s #g2 htotv hs) in + let htotg2 : ht: option(typing g2 (esubst s e2) (tot (tsubst s t))){Some? ht} = subst_on_tot s t; let Some htotv = htot in Some (typing_substitution #g1 #e2 #(tot t) s #g2 htotv hs) in let happg2 : typing g2 (EApp (esubst s e1) (esubst s e2)) (Cmp m (tsubst s (tsubst_ebeta e2 t')) (tsubst s (tyapp_wp m e2 t t' wp wp1 wp2))) = subst_on_tyapp_wp s m e2 t t' wp wp1 wp2; tsubst_on_ebeta s e2 t'; subst_on_bind s m (TArr t (Cmp m t' wp)) t wp1 wp2; TyApp #g2 #(esubst s e1) #(esubst s e2) #m #(tsubst s t) #(tsubst (sub_elam s) t') #(tsubst (sub_elam s) wp) #(tsubst s wp1) #(tsubst s wp2) ht1g2 ht2g2 (htotg2) None in happg2 ) else ( tsubst_on_neappears (elam_neappears0 s) t'; - let hkg2 : hk:(option (kinding g2 (teshd (tsubst (sub_elam s) t')) KType)){is_Some hk} = let temp : kinding g2 (teshd (tsubst (sub_elam s) t')) KType = tsubst_with_almost_eq (edec_elam_almost_eq s) t'; tsubst_comp s sub_edec t'; tsubst_comp sub_edec (sub_elam s) t'; kinding_substitution s (Some.v hk) hs in Some temp in + let hkg2 : hk:(option (kinding g2 (teshd (tsubst (sub_elam s) t')) KType)){Some? hk} = let temp : kinding g2 (teshd (tsubst (sub_elam s) t')) KType = tsubst_with_almost_eq (edec_elam_almost_eq s) t'; tsubst_comp s sub_edec t'; tsubst_comp sub_edec (sub_elam s) t'; kinding_substitution s (Some.v hk) hs in Some temp in let happg2 : typing g2 (EApp (esubst s e1) (esubst s e2)) (Cmp m (tsubst s (tsubst_ebeta e2 t')) (tsubst s (tyapp_wp m e2 t t' wp wp1 wp2))) = subst_on_tyapp_wp s m e2 t t' wp wp1 wp2; tsubst_on_ebeta s e2 t'; subst_on_bind s m (TArr t (Cmp m t' wp)) t wp1 wp2; TyApp #g2 #(esubst s e1) #(esubst s e2) #m #(tsubst s t) #(tsubst (sub_elam s) t') #(tsubst (sub_elam s) wp) #(tsubst s wp1) #(tsubst s wp2) ht1g2 ht2g2 None hkg2 in happg2 ) @@ -3793,7 +3793,7 @@ hs_sub_einc g2 (tsubst s t1) in (fun x -> match x with | 0 -> (tsubst_elam_shift s t1; TyVar 0 ) | n -> ( - (*x' -> s.es (x-1) = EVar x' /\ is_Some (lookup_evar g2 x') /\ tsubst s (lookup_evar g1 (x-1)).v = (lookup_evar g2 x').v*) + (*x' -> s.es (x-1) = EVar x' /\ Some? (lookup_evar g2 x') /\ tsubst s (lookup_evar g1 (x-1)).v = (lookup_evar g2 x').v*) (*ind -> typing g2ext (eesh s.ex (x-1)) (cesh (tot (tsubst s (g1 (x-1))))) *) (*subst_on_tot -> typing g2ext (eesh s.ex (x-1)) (tot (tesh (tsubst s (g1 (x-1)))))*) (*elam_shift -> typing g2ext (eesh s.ex (x-1)) (tot (tsubst (sub_elam s) (tesh (g1 (x-1))))) *) @@ -3958,7 +3958,7 @@ SubstTyping sub_id (textend k' g) (textend k g) (* ewf manipulation *) (********************) //{{{ -opaque val get_kinding_from_ewf : #g:env -> hw:ewf g -> x:var{is_Some (lookup_evar g x)} -> +opaque val get_kinding_from_ewf : #g:env -> hw:ewf g -> x:var{Some? (lookup_evar g x)} -> Tot (kinding g (Some.v (lookup_evar g x)) KType) (decreases %[hw]) let rec get_kinding_from_ewf g hw x = @@ -3975,7 +3975,7 @@ match hw with kinding_substitution sub_tinc hksub (hs_sub_tinc gsub ksub) ) -opaque val get_kwf_from_ewf : #g:env -> hewf: ewf g -> a:var{is_Some (lookup_tvar g a)} -> +opaque val get_kwf_from_ewf : #g:env -> hewf: ewf g -> a:var{Some? (lookup_tvar g a)} -> Tot (kwf g (Some.v (lookup_tvar g a))) (decreases %[hewf]) let rec get_kwf_from_ewf g hewf a = @@ -4078,7 +4078,7 @@ let kdg_return_pure g e t ht hk = opaque val kdg_tint : g:env -> Tot (kinding g tint KType) let kdg_tint g = KConst #g #TcInt (WFTcOther g TcInt) -opaque val kdg_tb : g:env -> tc:tconst{is_TcInt tc \/ is_TcHeap tc \/ is_TcRefInt tc} -> +opaque val kdg_tb : g:env -> tc:tconst{TcInt? tc \/ TcHeap? tc \/ TcRefInt? tc} -> Tot (kinding g (TConst tc) KType) let kdg_tb g tc = admit() @@ -4129,7 +4129,7 @@ opaque val v_impl_elim : #g:env -> #t1:typ -> #t2:typ -> Tot (validity g t2) let v_impl_elim g t1 t2 hv12 hv1 = admit() -opaque val v_assume : g:env -> x:var{is_Some (lookup_evar g x)} -> +opaque val v_assume : g:env -> x:var{Some? (lookup_evar g x)} -> Tot (validity g (Some.v (lookup_evar g x))) let v_assume g x = magic() @@ -4550,7 +4550,7 @@ type inversion_telam_res : env -> typ -> typ -> knd -> Type = kbodyb:knd -> hktarg : kinding g targ KType -> hktbody : kinding (eextend targ g) tbody kbodyb -> - hsk:option (skinding g (KTArr targ kbodyb) ks){KTArr targ kbodyb <> ks ==> is_Some hsk} -> + hsk:option (skinding g (KTArr targ kbodyb) ks){KTArr targ kbodyb <> ks ==> Some? hsk} -> (* SF : option only here, otherwise we need ewf of the environment … *) inversion_telam_res g targ tbody ks @@ -4578,7 +4578,7 @@ type inversion_ttlam_res : env -> knd -> typ -> knd -> Type = kbodyb:knd -> hkwfkarg : kwf g karg -> hktbody : kinding (textend karg g) tbody kbodyb -> - hsk:option (skinding g (KKArr karg kbodyb) ks){KKArr karg kbodyb <> ks ==> is_Some hsk} -> + hsk:option (skinding g (KKArr karg kbodyb) ks){KKArr karg kbodyb <> ks ==> Some? hsk} -> inversion_ttlam_res g karg tbody ks opaque val inversion_ttlam : #g:env -> #karg:knd -> #tbody:typ -> #ks:knd -> @@ -4943,7 +4943,7 @@ match hst with | SubConv #g #t t' hv hk -> ( let Cmp mc1 tc1 wp1 = c1 in - if not (is_TArr t) then + if not (TArr? t) then admit() else if true then @@ -5090,11 +5090,11 @@ match hst with | SubTrans #g #s #u #t hssu hsut -> ( let temp : either (styping_arrow_to_arrow_res g t1 c1 u) (validity g tfalse) = styping_arrow_to_arrow hwf hv hssu in - if (is_Inr temp) then Inr (Inr.v temp) else + if (Inr? temp) then Inr (Inr.v temp) else let StypingAToA #x1 #x2 #x3 #x4 #ut #uc hvtequ hstutt1 hscc1uc : styping_arrow_to_arrow_res g t1 c1 u = Inl.v temp in let temp : either (styping_arrow_to_arrow_res g ut uc t) (validity g tfalse) = styping_arrow_to_arrow hwf hvtequ hsut in - if (is_Inr temp) then Inr (Inr.v temp) else + if (Inr? temp) then Inr (Inr.v temp) else let StypingAToA #x5 #x6 #x7 #x8 #tt #tc hvteqt hstttut hscuctc : styping_arrow_to_arrow_res g ut uc t = Inl.v (temp) in (* needs g |- TArr ut uc : KType *) let hstttt1 : styping g tt t1 = SubTrans #g #tt #ut #t1 hstttut hstutt1 in let hs : subst_typing sub_id (eextend ut g) (eextend tt g) = styping_hs tt ut hstttut in @@ -5115,7 +5115,7 @@ opaque val styping_inv_arr : #g:env -> #t1:typ -> #c1:cmp -> #t2:typ -> #c2:cmp let styping_inv_arr g t1 c1 t2 c2 r1 r2 hwf hst hv1 hv2 = admit()(* let temp = styping_arrow_to_arrow #g #t1 #c1 #r1 #r2 hwf hv1 hst in -if is_Inr temp then Inr (Inr.v temp) +if Inr? temp then Inr (Inr.v temp) else let StypingAToA #x1 #x2 #x3 #x4 #t1' #c1' hvr2eqt1c1' hstt1't1 hscc1c1' : styping_arrow_to_arrow_res g t1 c1 r2 = Inl.v temp in (*hvr1eqt1c1 : r2 =_Type TArr t1' c1' @@ -5242,7 +5242,7 @@ type remove_subtyping_res : env -> exp -> cmp -> Type = | RemoveSub : #g:env -> #e:exp -> #c:cmp -> c' : cmp -> hsc: scmpex g e c' c -> - ht': typing g e c'{not(is_TySub ht') /\ not(is_TyRet ht')} -> + ht': typing g e c'{not(TySub? ht') /\ not(TyRet? ht')} -> remove_subtyping_res g e c opaque val remove_subtyping : #g:env -> #e:exp -> #c:cmp -> @@ -5251,7 +5251,7 @@ opaque val remove_subtyping : #g:env -> #e:exp -> #c:cmp -> Tot(remove_subtyping_res g e c) (decreases %[ht]) let rec remove_subtyping g e c hwf ht = -if not (is_TySub ht) && not (is_TyRet ht) then +if not (TySub? ht) && not (TyRet? ht) then let Cmp mc tc wpc = c in let TypingDerived hktc hkwpc hvmonoc = typing_derived #g #e #mc #tc #wpc hwf ht in let hsc : scmp g c c = scmp_refl #g #mc #tc #wpc hktc hkwpc hvmonoc in @@ -5311,8 +5311,8 @@ type app_inversion_res : g:env -> e1:exp -> e2:exp -> ms:eff -> trets:typ -> wp0 mb:eff{eff_sub mb ms} -> targ:typ -> tbody:typ -> wpbody:typ -> wp1:typ -> wp2:typ -> ht1:typing g e1 (Cmp mb (TArr targ (Cmp mb tbody wpbody)) wp1) -> ht2:typing g e2 (Cmp mb targ wp2) -> - htotarg:option (typing g e2 (tot targ)){teappears 0 tbody ==> is_Some htotarg} -> - hktbody:option (kinding g (teshd tbody) KType){not (teappears 0 tbody) ==> is_Some hktbody} -> + htotarg:option (typing g e2 (tot targ)){teappears 0 tbody ==> Some? htotarg} -> + hktbody:option (kinding g (teshd tbody) KType){not (teappears 0 tbody) ==> Some? hktbody} -> hst:styping g (tsubst_ebeta e2 tbody) trets -> hinvtot : inversion_tot_res g (EApp e1 e2) mb (tsubst_ebeta e2 tbody) (tyapp_wp mb e2 targ tbody wpbody wp1 wp2) ms trets wp0 -> app_inversion_res g e1 e2 ms trets wp0 @@ -5396,7 +5396,7 @@ match ht with ) -opaque val value_inversion : #g:env -> #e:exp{is_value e \/ is_EVar e} -> +opaque val value_inversion : #g:env -> #e:exp{is_value e \/ EVar? e} -> #m:eff -> #t:typ -> #wp:typ -> hwf:ewf g -> ht:typing g e (Cmp m t wp) -> @@ -5512,7 +5512,7 @@ opaque val pure_kinding_preservation : #g:env -> #t:typ -> #t':typ -> #k:knd -> (decreases %[hk]) let rec pure_typing_preservation g e e' t wp post hwf ht hstep hv = -if is_TySub ht then +if TySub? ht then let TySub #x1 #x2 #c' #c ht' hsc = ht in let Cmp mc' tc' wpc' = c' in let hv' : validity g (TTApp wpc' post) = @@ -5525,7 +5525,7 @@ if is_TySub ht then let ht' : typing g e' c' = temp in Inl (TySub #g #e' #c' #c ht' hsc) ) -else if is_TyRet ht then +else if TyRet? ht then let TyRet t htot = ht in let posttot = TELam t ttrue in let wp' = tot_wp t in @@ -5721,7 +5721,7 @@ and match pure_typing_preservation #g #earg #earg' #targ #(tot_wp targ) #postfun hwf htotargv hsteparg hvpost with | Inr temp -> Inr temp | Inl temp -> - let htotarg' : h:option (typing g earg' (tot targ)){is_Some h} = Some temp in + let htotarg' : h:option (typing g earg' (tot targ)){Some? h} = Some temp in Inl (TyApp #g #efun #earg' #EfPure #targ #tbody #wpbody #wp1 #wp2 ht1 htarg' htotarg' None) ) else @@ -5851,7 +5851,7 @@ and ) | _ -> admit() and pure_kinding_preservation g t t' k hwf hk hstep = -if is_KSub hk then +if KSub? hk then let KSub #g #t #k' #k hk' hsk = hk in match pure_kinding_preservation hwf hk' hstep with | Inr temp -> Inr temp @@ -6030,7 +6030,7 @@ opaque val styping_inversion_arrow_empty : #t1:typ -> #c1:cmp -> #t:typ -> Tot (styping_inv_arr_res empty t1 c1 t) let styping_inversion_arrow_empty t1 c1 t hst = magic() -opaque val value_inversion_empty : #e:exp{is_value e \/ is_EVar e} -> +opaque val value_inversion_empty : #e:exp{is_value e \/ EVar? e} -> #m:eff -> #t:typ -> #wp:typ -> ht:typing empty e (Cmp m t wp) -> Tot (typing empty e (tot t)) @@ -6284,7 +6284,7 @@ match ht with ) //}}} *) -opaque val tb_inversion_styping' : #t':typ -> #t:typ -> #tc:tconst{is_TcHeap tc \/ is_TcInt tc \/ is_TcRefInt tc} -> +opaque val tb_inversion_styping' : #t':typ -> #t:typ -> #tc:tconst{TcHeap? tc \/ TcInt? tc \/ TcRefInt? tc} -> hst : styping empty t' t -> hv : validity empty (teqtype t (TConst tc)) -> Tot (validity empty (teqtype t' (TConst tc))) @@ -6317,7 +6317,7 @@ type tb_inversion_res : exp -> tconst -> Type = tb_inversion_res e TcRefInt opaque val tb_inversion_empty_helper : - e:exp -> targ : typ -> cbody : cmp -> t:typ -> tc:tconst{is_TcHeap tc \/ is_TcInt tc \/ is_TcRefInt tc} -> + e:exp -> targ : typ -> cbody : cmp -> t:typ -> tc:tconst{TcHeap? tc \/ TcInt? tc \/ TcRefInt? tc} -> hst : styping empty (TArr targ cbody) t -> hv : validity empty (teqtype t (TConst tc)) -> Tot (tb_inversion_res e tc) @@ -6328,7 +6328,7 @@ let tb_inversion_empty_helper e targ cbody t tc hst hv = let hvfalse : validity empty tfalse = v_impl_elim #empty #(teqtype (TArr targ cbody) (TConst tc)) #tfalse hvnot hv in empty_consistent hvfalse; TcIntInversion e (TintInversion e 42 Refl) -opaque val tb_inversion_empty : #v:value -> #t:typ -> #wp:typ -> #tc:tconst{is_TcHeap tc \/ is_TcInt tc \/ is_TcRefInt tc} -> +opaque val tb_inversion_empty : #v:value -> #t:typ -> #wp:typ -> #tc:tconst{TcHeap? tc \/ TcInt? tc \/ TcRefInt? tc} -> ht:typing empty v (Cmp EfPure t wp) -> hv:validity empty (teqtype t (TConst tc)) -> Tot (tb_inversion_res v tc) diff --git a/examples/metatheory/ParSubst.fst b/examples/metatheory/ParSubst.fst index 568a36fdb3a..074fcffe4de 100644 --- a/examples/metatheory/ParSubst.fst +++ b/examples/metatheory/ParSubst.fst @@ -32,7 +32,7 @@ type exp = | EAbs : ty -> exp -> exp val is_value : exp -> Tot bool -let is_value = is_EAbs +let is_value = EAbs? (* Parallel substitution operation `subst` *) @@ -49,7 +49,7 @@ let is_value = is_EAbs (* assume val excluded_middle : p:Type -> Tot (b:bool{b = true <==> p}) *) type sub = var -> Tot exp -type renaming (s:sub) = (forall (x:var). is_EVar (s x)) +type renaming (s:sub) = (forall (x:var). EVar? (s x)) assume val is_renaming : s:sub -> Tot (n:int{(renaming s ==> n=0) /\ (~(renaming s) ==> n=1)}) @@ -60,18 +60,18 @@ let sub_inc y = EVar (y+1) val renaming_sub_inc : unit -> Lemma (renaming (sub_inc)) let renaming_sub_inc _ = () -let is_var (e:exp) : int = if is_EVar e then 0 else 1 +let is_var (e:exp) : int = if EVar? e then 0 else 1 val subst : e:exp -> s:sub -> Pure exp (requires True) - (ensures (fun e' -> renaming s /\ is_EVar e ==> is_EVar e')) + (ensures (fun e' -> renaming s /\ EVar? e ==> EVar? e')) (decreases %[is_var e; is_renaming s; e]) let rec subst e s = match e with | EVar x -> s x | EAbs t e1 -> - let subst_eabs : y:var -> Tot (e:exp{renaming s ==> is_EVar e}) = fun y -> + let subst_eabs : y:var -> Tot (e:exp{renaming s ==> EVar? e}) = fun y -> if y=0 then EVar y else ((* renaming_sub_inc (); --unnecessary hint *) diff --git a/examples/metatheory/StlcCbvDbParSubst.fst b/examples/metatheory/StlcCbvDbParSubst.fst index 50a7aa28a5f..b9868c8cd44 100644 --- a/examples/metatheory/StlcCbvDbParSubst.fst +++ b/examples/metatheory/StlcCbvDbParSubst.fst @@ -66,7 +66,7 @@ let rec step e = | _ -> None val progress : #e:exp -> #t:typ -> h:typing empty e t -> - Lemma (requires True) (ensures (is_value e \/ (is_Some (step e)))) (decreases h) + Lemma (requires True) (ensures (is_value e \/ (Some? (step e)))) (decreases h) let rec progress #e #t h = match h with | TyVar _ -> () @@ -109,7 +109,7 @@ let rec context_invariance #e #g #t h g' = | TyUnit -> TyUnit val free_in_context : x:var -> #e:exp -> #g:env -> #t:typ -> h:typing g e t -> - Lemma (requires True) (ensures (appears_free_in x e ==> is_Some (g x))) (decreases h) + Lemma (requires True) (ensures (appears_free_in x e ==> Some? (g x))) (decreases h) let rec free_in_context x #e #g #t h = match h with | TyVar x -> () @@ -269,8 +269,8 @@ val extend_gen_0 : t:typ -> g:env -> let extend_gen_0 t g = forall_intro (extend_gen_0_aux t g) -val preservation : #e:exp -> #t:typ -> h:typing empty e t{is_Some (step e)} -> - Tot (typing empty (Some.v (step e)) t) (decreases e) +val preservation : #e:exp -> #t:typ -> h:typing empty e t{Some? (step e)} -> + Tot (typing empty (Some?.v (step e)) t) (decreases e) let rec preservation #e #t h = let TyApp #g #e1 #e2 #t11 #t12 h1 h2 = h in if is_value e1 @@ -278,5 +278,5 @@ let rec preservation #e #t h = then let TyLam t_x hbody = h1 in (extend_gen_0 t_x empty; substitution_preserves_typing 0 h2 hbody) - else TyApp #_ #_ #(Some.v (step e2)) #_ #_ h1 (preservation h2)) - else TyApp #_ #(Some.v (step e1)) #_ #_ #_ (preservation h1) h2 + else TyApp #_ #_ #(Some?.v (step e2)) #_ #_ h1 (preservation h2)) + else TyApp #_ #(Some?.v (step e1)) #_ #_ #_ (preservation h1) h2 diff --git a/examples/metatheory/StlcCbvDbPntSubstLists.fst b/examples/metatheory/StlcCbvDbPntSubstLists.fst index e14947e96df..0625891e32b 100644 --- a/examples/metatheory/StlcCbvDbPntSubstLists.fst +++ b/examples/metatheory/StlcCbvDbPntSubstLists.fst @@ -64,7 +64,7 @@ let rec subst_zero_lem e1 e2 = match e1 with | EApp e1' e2' -> (subst_zero_lem e1' e2; subst_zero_lem e2' e2) val is_value: exp -> Tot bool -let is_value = is_EAbs +let is_value = EAbs? val step: exp -> Tot (option exp) let rec step = function @@ -99,8 +99,8 @@ let rec typing g e = match e with | Some (TArrow t1 t2), Some t1' -> if t1 = t1' then Some t2 else None | _, _ -> None -val progress: e:exp{is_Some (typing [] e)} -> - Lemma (requires True) (ensures (is_value e \/ is_Some (step e))) +val progress: e:exp{Some? (typing [] e)} -> + Lemma (requires True) (ensures (is_value e \/ Some? (step e))) let rec progress e = match e with | EApp e1 e2 -> progress e1; progress e2 @@ -126,13 +126,13 @@ val list_assoc_b: g:env -> g':env -> t1':typ -> t:typ -> Lemma (requires True) ( let list_assoc_b g g' t1' t = () (* inversion for lookup, lookup for indices less than length of env succeeds *) -val lookup_inv: g:env -> n:nat -> Lemma (requires True) (ensures (if n < len g then is_Some (lookup g n) else is_None (lookup g n))) [SMTPat (lookup g n)] +val lookup_inv: g:env -> n:nat -> Lemma (requires True) (ensures (if n < len g then Some? (lookup g n) else None? (lookup g n))) [SMTPat (lookup g n)] let rec lookup_inv g n = match g with | [] -> () | _::tl -> if n = 0 then () else lookup_inv tl (n - 1) (* inversion for lookup in app, lookup in g' @ g means either lookup in g' or in g *) -val lookup_app_inv: g:env -> g':env -> k:nat{is_Some (lookup (g' @ g) k)} -> Lemma (requires (True)) +val lookup_app_inv: g:env -> g':env -> k:nat{Some? (lookup (g' @ g) k)} -> Lemma (requires (True)) (ensures ((k < len g' /\ lookup (g' @ g) k = lookup g' k) \/ (k >= len g' /\ lookup (g' @ g) k = lookup g (k - len g')))) [SMTPat (lookup (g' @ g) k)] let rec lookup_app_inv g g' k = match g' with @@ -140,8 +140,8 @@ let rec lookup_app_inv g g' k = match g' with | hd::tl -> if k = 0 then () else lookup_app_inv g tl (k - 1) (* lookup g k ==> lookup (g' @ g) (k + len g') *) -val lookup_ext_f: g:env -> n:nat{is_Some (lookup g n)} -> g':env -> - Lemma (requires True) (ensures (is_Some (lookup (g' @ g) (n + len g')) /\ +val lookup_ext_f: g:env -> n:nat{Some? (lookup g n)} -> g':env -> + Lemma (requires True) (ensures (Some? (lookup (g' @ g) (n + len g')) /\ Some.v (lookup (g' @ g) (n + len g')) = Some.v (lookup g n))) (decreases g') let rec lookup_ext_f g n g' = match g' with @@ -149,8 +149,8 @@ let rec lookup_ext_f g n g' = match g' with | _::tl -> lookup_ext_f g n tl (* if g' @ g |- e : t then g' @ g'' @ g |- (shift e (len g') (len g'')) : t *) -val weakening: g:env -> g':env -> g'':env -> e:exp{is_Some (typing (g' @ g) e)} -> - Lemma (requires True) (ensures (is_Some (typing (g' @ (g'' @ g)) (shift e (len g') (len g''))) /\ +val weakening: g:env -> g':env -> g'':env -> e:exp{Some? (typing (g' @ g) e)} -> + Lemma (requires True) (ensures (Some? (typing (g' @ (g'' @ g)) (shift e (len g') (len g''))) /\ Some.v (typing (g' @ (g'' @ g)) (shift e (len g') (len g''))) = Some.v (typing (g' @ g) e))) (decreases e) let rec weakening g g' g'' e = match e with | EVar k -> @@ -168,8 +168,8 @@ let rec free_in e x = match e with | EApp e1 e2 -> free_in e1 x || free_in e2 x (* if g' @ (t::g) |- e : t and (len g') is not free in e, then we can essentially drop t from gamma (but adjust the indices in e *) -val strengthening: g:env -> g':env -> t:typ -> e:exp{is_Some (typing (g' @ (t::g)) e) /\ not (free_in e (len g'))} -> - Lemma (requires True) (ensures (is_Some (typing (g' @ g) (shift e (len g' + 1) (-1))) /\ +val strengthening: g:env -> g':env -> t:typ -> e:exp{Some? (typing (g' @ (t::g)) e) /\ not (free_in e (len g'))} -> + Lemma (requires True) (ensures (Some? (typing (g' @ g) (shift e (len g' + 1) (-1))) /\ Some.v (typing (g' @ g) (shift e (len g' + 1) (-1))) = Some.v (typing (g' @ (t::g)) e))) (decreases e) let rec strengthening g g' t e = match e with | EVar k -> @@ -211,8 +211,8 @@ let sexp e1 n e2 = shift (substitute e1 n (shift e2 0 (n + 1))) (n + 1) (-1) (* * if g |- e2 : t2, g' @ (t2::g) |- e1 : t1, then g' @ g |- sexp e1 (len g') e2 : t1 *) -val subst_lem: g:env -> e2:exp{is_Some (typing g e2)} -> g':env -> e1:exp{is_Some (typing (g' @ ((Some.v (typing g e2))::g)) e1)} -> - Lemma (requires True) (ensures (is_Some (typing (g' @ g) (sexp e1 (len g') e2)) /\ +val subst_lem: g:env -> e2:exp{Some? (typing g e2)} -> g':env -> e1:exp{Some? (typing (g' @ ((Some.v (typing g e2))::g)) e1)} -> + Lemma (requires True) (ensures (Some? (typing (g' @ g) (sexp e1 (len g') e2)) /\ Some.v (typing (g' @ g) (sexp e1 (len g') e2)) = Some.v (typing (g' @ ((Some.v (typing g e2))::g)) e1))) (decreases e1) let rec subst_lem g e2 g' e1 = @@ -235,10 +235,10 @@ let rec subst_lem g e2 g' e1 = consec_shifts_lem e2 0 (len g' + 1) 1) | EApp e1' e2' -> subst_lem g e2 g' e1'; subst_lem g e2 g' e2' -val preservation: g:env -> e:exp{is_Some (typing g e)} -> +val preservation: g:env -> e:exp{Some? (typing g e)} -> Lemma (requires True) - (ensures (is_Some (step e) ==> - (is_Some (typing g (Some.v (step e))) /\ + (ensures (Some? (step e) ==> + (Some? (typing g (Some.v (step e))) /\ Some.v (typing g (Some.v (step e))) = Some.v (typing g e)))) (decreases e) let rec preservation g e = match e with @@ -263,15 +263,15 @@ let rec preservation g e = match e with (*let id = EAbs TBool (EVar 0) (* \x.x *) let id_app_id = EApp id id (* (\x.x) (\x.x) *) -let test0 = assert (is_Some (step id_app_id) /\ Some.v (step id_app_id) = id) +let test0 = assert (Some? (step id_app_id) /\ Some.v (step id_app_id) = id) let self_app = EAbs TBool (EApp (EVar 0) (EVar 0)) (* \x. x x *) let self_app_app_id = EApp self_app id -let test1 = assert (is_Some (step self_app_app_id) /\ Some.v (step self_app_app_id) = id_app_id) +let test1 = assert (Some? (step self_app_app_id) /\ Some.v (step self_app_app_id) = id_app_id) let self_app_app_self_app = EApp self_app self_app -let test2 = assert (is_Some (step self_app_app_self_app) /\ Some.v (step self_app_app_self_app) = self_app_app_self_app) +let test2 = assert (Some? (step self_app_app_self_app) /\ Some.v (step self_app_app_self_app) = self_app_app_self_app) (* two binders *) let app_fn = EAbs TBool (EAbs TBool (EApp (EVar 1) (EVar 0))) (* \x \y. x y *) @@ -283,5 +283,5 @@ let s2 = | None -> None | Some s1' -> step s1' -let test3 = assert (is_Some s2 /\ Some.v s2 = id_app_id)*) +let test3 = assert (Some? s2 /\ Some.v s2 = id_app_id)*) *) diff --git a/examples/metatheory/StlcCbvDbPntSubstNoLists.fst b/examples/metatheory/StlcCbvDbPntSubstNoLists.fst index 03a8d9c5940..a7d8cd47fcf 100644 --- a/examples/metatheory/StlcCbvDbPntSubstNoLists.fst +++ b/examples/metatheory/StlcCbvDbPntSubstNoLists.fst @@ -27,7 +27,7 @@ type exp = | EAbs : ty -> exp -> exp val is_value : exp -> Tot bool -let is_value = is_EAbs +let is_value = EAbs? (* subst_beta is a generalization of the substitution we do for the beta rule, when we've under x binders (useful for the substitution lemma) *) @@ -74,8 +74,8 @@ let extend g x t y = if y < x then g y noeq type rtyping : env -> exp -> ty -> Type = | TyVar : #g:env -> - x:var{is_Some (g x)} -> - rtyping g (EVar x) (Some.v (g x)) + x:var{Some? (g x)} -> + rtyping g (EVar x) (Some?.v (g x)) | TyAbs : #g:env -> t:ty -> #e1:exp -> @@ -92,7 +92,7 @@ noeq type rtyping : env -> exp -> ty -> Type = rtyping g (EApp e1 e2) t12 val progress : #e:exp -> #t:ty -> h:rtyping empty e t -> - Lemma (requires True) (ensures (is_value e \/ (is_Some (step e)))) (decreases h) + Lemma (requires True) (ensures (is_value e \/ (Some? (step e)))) (decreases h) let rec progress #e #t h = match h with | TyVar _ -> () @@ -107,7 +107,7 @@ let rec appears_free_in x e = | EAbs _ e1 -> appears_free_in (x+1) e1 val free_in_context : x:var -> #e:exp -> #g:env -> #t:ty -> h:rtyping g e t -> - Lemma (requires True) (ensures (appears_free_in x e ==> is_Some (g x))) (decreases h) + Lemma (requires True) (ensures (appears_free_in x e ==> Some? (g x))) (decreases h) let rec free_in_context x #e #g #t h = match h with | TyVar x -> () @@ -164,15 +164,14 @@ let rec substitution_preserves_typing x #e #v #t_x #t #g h1 h2 = (substitution_preserves_typing x h1 h21) (substitution_preserves_typing x h1 h22)) -val preservation : #e:exp -> #t:ty -> h:rtyping empty e t{is_Some (step e)} -> - Tot (rtyping empty (Some.v (step e)) t) (decreases e) +val preservation : #e:exp -> #t:ty -> h:rtyping empty e t{Some? (step e)} -> + Tot (rtyping empty (Some?.v (step e)) t) (decreases e) let rec preservation #e #t h = let TyApp #g #e1 #e2 #t11 #t12 h1 h2 = h in if is_value e1 then (if is_value e2 then let TyAbs t_x hbody = h1 in substitution_preserves_typing 0 h2 hbody - else TyApp #_ #_ #(Some.v (step e2)) #_ #_ h1 (preservation h2)) + else TyApp #_ #_ #(Some?.v (step e2)) #_ #_ h1 (preservation h2)) //^^^^^^^^^^^^^^^^^ - else TyApp #_ #(Some.v (step e1)) #_ #_ #_ (preservation h1) h2 - //^^^^^^^^^^^^^^^^^ these implicits have non-trivial pre-conditions + else TyApp #_ #(Some?.v (step e1)) #_ #_ #_ (preservation h1) h2 diff --git a/examples/metatheory/StlcCbvNamed.fst b/examples/metatheory/StlcCbvNamed.fst index b0c061af23b..5c8cda3fcdd 100644 --- a/examples/metatheory/StlcCbvNamed.fst +++ b/examples/metatheory/StlcCbvNamed.fst @@ -183,17 +183,17 @@ let rec typing g e = progress proofs; they are not used by the automated proof below *) val canonical_forms_bool : e:exp -> Lemma (requires (typing empty e == Some TBool /\ is_value e)) - (ensures (is_ETrue e \/ is_EFalse e)) + (ensures (ETrue? e \/ EFalse? e)) let canonical_forms_bool e = () val canonical_forms_fun : e:exp -> t1:ty -> t2:ty -> Lemma (requires (typing empty e == Some (TArrow t1 t2) /\ is_value e)) - (ensures (is_EAbs e)) + (ensures (EAbs? e)) let canonical_forms_fun e t1 t2 = () val progress : e:exp -> Lemma - (requires (is_Some (typing empty e))) - (ensures (is_value e \/ (is_Some (step e)))) + (requires (Some? (typing empty e))) + (ensures (is_value e \/ (Some? (step e)))) let rec progress e = by_induction_on e progress val appears_free_in : x:int -> e:exp -> Tot bool @@ -212,8 +212,8 @@ let rec appears_free_in x e = | ELet y e1 e2 -> appears_free_in x e1 || (x <> y && appears_free_in x e2) val free_in_context : x:int -> e:exp -> g:env -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) let rec free_in_context x e g = match e with | EVar _ @@ -237,9 +237,9 @@ let rec free_in_context x e g = pre-type-check and then it doesn't really help verifying this more automatically (left some admits there). val free_in_context' : g:env -> x:int -> e:exp -> Lemma - (requires (is_Some (typing g e))) - (ensures (appears_free_in x e ==> is_Some (g x))) - [SMTPat (appears_free_in x e); SMTPat (is_Some (typing g e))] + (requires (Some? (typing g e))) + (ensures (appears_free_in x e ==> Some? (g x))) + [SMTPat (appears_free_in x e); SMTPat (Some? (typing g e))] let rec free_in_context' g x e = match e with | EVar _ @@ -261,7 +261,7 @@ let rec free_in_context' g x e = (* Corollary of free_in_context when g=empty -- fed to the SMT solver *) val typable_empty_closed : x:int -> e:exp -> Lemma - (requires (is_Some (typing empty e))) + (requires (Some? (typing empty e))) (ensures (not(appears_free_in x e))) [SMTPat (appears_free_in x e)] let typable_empty_closed x e = free_in_context x e empty @@ -322,8 +322,8 @@ val typing_extensional : g:env -> g':env -> e:exp let typing_extensional g g' e = context_invariance e g g' val substitution_preserves_typing : x:int -> e:exp -> v:exp -> - g:env{is_Some (typing empty v) && - is_Some (typing (extend g x (Some.v (typing empty v))) e)} -> + g:env{Some? (typing empty v) && + Some? (typing (extend g x (Some.v (typing empty v))) e)} -> Tot (u:unit{typing g (subst x v e) == typing (extend g x (Some.v (typing empty v))) e}) let rec substitution_preserves_typing x e v g = @@ -375,7 +375,7 @@ let rec substitution_preserves_typing x e v g = typing_extensional gxy gyx e2; substitution_preserves_typing x e2 v gy)) -val preservation : e:exp{is_Some (typing empty e) /\ is_Some (step e)} -> +val preservation : e:exp{Some? (typing empty e) /\ Some? (step e)} -> Tot (u:unit{typing empty (Some.v (step e)) == typing empty e}) let rec preservation e = match e with @@ -405,19 +405,19 @@ let rec preservation e = (if is_value e1 then substitution_preserves_typing x e2 e1 empty else preservation e1) -val typed_step : e:exp{is_Some (typing empty e) /\ not(is_value e)} -> +val typed_step : e:exp{Some? (typing empty e) /\ not(is_value e)} -> Tot (e':exp{typing empty e' = typing empty e}) let typed_step e = progress e; preservation e; Some.v (step e) (* Here is a solution that only uses typed_step (suggested by Santiago Zanella) *) -val eval : e:exp{is_Some (typing empty e)} -> +val eval : e:exp{Some? (typing empty e)} -> Dv (v:exp{is_value v && typing empty v = typing empty e}) let rec eval e = if is_value e then e else eval (typed_step e) (* Here is a solution that only uses the substitution lemma *) -val eval' : e:exp{is_Some (typing empty e)} -> +val eval' : e:exp{Some? (typing empty e)} -> Dv (v:exp{is_value v && typing empty v = typing empty e}) let rec eval' e = let Some t = typing empty e in diff --git a/examples/metatheory/StlcStrongDbParSubst.fst b/examples/metatheory/StlcStrongDbParSubst.fst index 505e1eb4192..52b294822ba 100644 --- a/examples/metatheory/StlcStrongDbParSubst.fst +++ b/examples/metatheory/StlcStrongDbParSubst.fst @@ -52,7 +52,7 @@ type exp = type sub = var -> Tot exp -type renaming (s:sub) = (forall (x:var). is_EVar (s x)) +type renaming (s:sub) = (forall (x:var). EVar? (s x)) val is_renaming : s:sub -> GTot (n:int{ (renaming s ==> n=0) /\ (~(renaming s) ==> n=1)}) @@ -65,16 +65,16 @@ let sub_inc y = EVar (y+1) val renaming_sub_inc : unit -> Lemma (renaming (sub_inc)) let renaming_sub_inc _ = () -let is_var (e:exp) : int = if is_EVar e then 0 else 1 +let is_var (e:exp) : int = if EVar? e then 0 else 1 val subst : s:sub -> e:exp -> Pure exp (requires True) - (ensures (fun e' -> (renaming s /\ is_EVar e) ==> is_EVar e')) + (ensures (fun e' -> (renaming s /\ EVar? e) ==> EVar? e')) (decreases %[is_var e; is_renaming s; e]) let rec subst s e = match e with | EVar x -> s x | ELam t e1 -> - let sub_elam : y:var -> Tot (e:exp{renaming s ==> is_EVar e}) = + let sub_elam : y:var -> Tot (e:exp{renaming s ==> EVar? e}) = fun y -> if y=0 then EVar y else subst sub_inc (s (y-1)) (* shift +1 *) in ELam t (subst sub_elam e1) @@ -122,8 +122,8 @@ let extend t g y = if y = 0 then Some t noeq type typing : env -> exp -> typ -> Type = | TyVar : #g:env -> - x:var{is_Some (g x)} -> - typing g (EVar x) (Some.v (g x)) + x:var{Some? (g x)} -> + typing g (EVar x) (Some?.v (g x)) | TyLam : #g :env -> t :typ -> #e1:exp -> @@ -144,7 +144,7 @@ noeq type typing : env -> exp -> typ -> Type = (* Progress *) val is_value : exp -> Tot bool -let is_value e = is_ELam e || is_EUnit e +let is_value e = ELam? e || EUnit? e val progress : #e:exp -> #t:typ -> h:typing empty e t -> Pure (cexists (fun e' -> step e e')) @@ -167,7 +167,7 @@ let subst_extensional s1 s2 e = () (* Typing of substitutions (very easy, actually) *) type subst_typing (s:sub) (g1:env) (g2:env) = - (x:var{is_Some (g1 x)} -> Tot(typing g2 (s x) (Some.v (g1 x)))) + (x:var{Some? (g1 x)} -> Tot(typing g2 (s x) (Some?.v (g1 x)))) (* Substitution preserves typing Strongest possible statement; suggested by Steven Schäfer *) @@ -187,7 +187,7 @@ let rec substitution #g1 #e #t s #g2 h1 hs = let hs' : subst_typing (sub_elam s) (extend tlam g1) (extend tlam g2) = fun y -> if y = 0 then TyVar y else let n:var = y - 1 in //Silly limitation of implicits and refinements - substitution #_ #_ #(Some.v (g1 n)) sub_inc #_ (hs n) hs'' //NS: needed to instantiate the Some.v + substitution #_ #_ #(Some?.v (g1 n)) sub_inc #_ (hs n) hs'' //NS: needed to instantiate the Some?.v in TyLam tlam (substitution (sub_elam s) hbody hs') | TyUnit -> TyUnit @@ -211,6 +211,6 @@ val preservation : #e:exp -> #e':exp -> #g:env -> #t:typ -> let rec preservation #e #e' #g #t ht hs = let TyApp h1 h2 = ht in match hs with - | SBeta tx e1' e2' -> substitution_beta #e1' #_ #_ #t #_ h2 (TyLam.hbody h1) + | SBeta tx e1' e2' -> substitution_beta #e1' #_ #_ #t #_ h2 (TyLam?.hbody h1) | SApp1 e2' hs1 -> TyApp (preservation h1 hs1) h2 | SApp2 e1' hs2 -> TyApp h1 (preservation h2 hs2) diff --git a/examples/metatheory/attic/lambda_omega.fst b/examples/metatheory/attic/lambda_omega.fst index 4e57da6289a..e5d431da57c 100644 --- a/examples/metatheory/attic/lambda_omega.fst +++ b/examples/metatheory/attic/lambda_omega.fst @@ -48,7 +48,7 @@ type exp = (in this calculus doesn't interact with type substitution below) *) type esub = var -> Tot exp -type erenaming (s:esub) = (forall (x:var). is_EVar (s x)) +type erenaming (s:esub) = (forall (x:var). EVar? (s x)) val is_erenaming : s:esub -> Tot (n:int{( erenaming s ==> n=0) /\ (~(erenaming s) ==> n=1)}) @@ -63,17 +63,17 @@ let esub_inc = esub_inc_above 0 val erenaming_sub_inc : unit -> Lemma (erenaming (esub_inc)) let erenaming_sub_inc _ = () -let is_evar (e:exp) : int = if is_EVar e then 0 else 1 +let is_evar (e:exp) : int = if EVar? e then 0 else 1 val esubst : s:esub -> e:exp -> Pure exp (requires True) - (ensures (fun e' -> erenaming s /\ is_EVar e ==> is_EVar e')) + (ensures (fun e' -> erenaming s /\ EVar? e ==> EVar? e')) (decreases %[is_evar e; is_erenaming s; e]) let rec esubst s e = match e with | EVar x -> s x | ELam t e1 -> - let esubst_lam : y:var -> Tot (e:exp{erenaming s ==> is_EVar e}) = + let esubst_lam : y:var -> Tot (e:exp{erenaming s ==> EVar? e}) = fun y -> if y=0 then EVar y else (esubst esub_inc (s (y - 1))) in ELam t (esubst esubst_lam e1) @@ -86,7 +86,7 @@ let esubst_lam s y = else esubst esub_inc (s (y-1)) val esubst_lam_renaming: s:esub -> Lemma - (ensures (forall (x:var). erenaming s ==> is_EVar (esubst_lam s x))) + (ensures (forall (x:var). erenaming s ==> EVar? (esubst_lam s x))) let esubst_lam_renaming s = () (* Substitution extensional; trivial with the extensionality axiom *) @@ -251,7 +251,7 @@ let esubst_beta = esubst_beta_gen 0 (* Substitution on types is very much analogous *) type tsub = var -> Tot typ -opaque type trenaming (s:tsub) = (forall (x:var). is_TVar (s x)) +opaque type trenaming (s:tsub) = (forall (x:var). TVar? (s x)) val is_trenaming : s:tsub -> Tot (n:int{( trenaming s ==> n=0) /\ (~(trenaming s) ==> n=1)}) @@ -266,17 +266,17 @@ let tsub_inc = tsub_inc_above 0 val trenaming_sub_inc : unit -> Lemma (trenaming (tsub_inc)) let trenaming_sub_inc _ = () -let is_tvar (t:typ) : int = if is_TVar t then 0 else 1 +let is_tvar (t:typ) : int = if TVar? t then 0 else 1 val tsubst : s:tsub -> t:typ -> Pure typ (requires True) - (ensures (fun t' -> trenaming s /\ is_TVar t ==> is_TVar t')) + (ensures (fun t' -> trenaming s /\ TVar? t ==> TVar? t')) (decreases %[is_tvar t; is_trenaming s; t]) let rec tsubst s t = match t with | TVar x -> s x | TLam k t1 -> - let tsubst_lam : y:var -> Tot (t:typ{trenaming s ==> is_TVar t}) = + let tsubst_lam : y:var -> Tot (t:typ{trenaming s ==> TVar? t}) = fun y -> if y=0 then TVar y else (tsubst tsub_inc (s (y-1))) in TLam k (tsubst tsubst_lam t1) @@ -412,7 +412,7 @@ let extend_evar g n t = type kinding : env -> typ -> knd -> Type = | KiVar : #g:env -> - a:var{is_Some (lookup_tvar g a)} -> + a:var{Some? (lookup_tvar g a)} -> kinding g (TVar a) (Some.v (lookup_tvar g a)) | KiLam : #g:env -> k:knd -> @@ -474,7 +474,7 @@ type tequiv : typ -> typ -> Type = type typing : env -> exp -> typ -> Type = | TyVar : #g:env -> - x:var{is_Some (lookup_evar g x)} -> + x:var{Some? (lookup_evar g x)} -> kinding g (Some.v (lookup_evar g x)) KTyp -> typing g (EVar x) (Some.v (lookup_evar g x)) | TyLam : #g:env -> @@ -504,7 +504,7 @@ type typing : env -> exp -> typ -> Type = (* Progress proof *) val is_value : exp -> Tot bool -let is_value = is_ELam +let is_value = ELam? opaque val progress : #e:exp -> #t:typ -> h:typing empty e t -> Pure (cexists (fun e' -> step e e')) diff --git a/examples/preorders/MRefST.fst b/examples/preorders/MRefST.fst index 7b7a4928aa6..ad37eaa8f3b 100644 --- a/examples/preorders/MRefST.fst +++ b/examples/preorders/MRefST.fst @@ -98,11 +98,11 @@ effect IST (a:Type) (* Generic effects (operations) for IST. *) val ist_get : unit -> IST heap (fun s0 -> True) (fun s0 s s1 -> s0 == s /\ s == s1) -let ist_get () = ISTATE.get() +let ist_get () = ISTATE?.get() val ist_put : x:heap -> IST unit (fun s0 -> heap_rel s0 x) (fun s0 _ s1 -> s1 == x) -let ist_put x = ISTATE.put x +let ist_put x = ISTATE?.put x (* A box-like modality for witnessed stable predicates for IST. *) diff --git a/examples/preorders/NatHeap.fst b/examples/preorders/NatHeap.fst index 89399f04f49..93a2e0791dc 100644 --- a/examples/preorders/NatHeap.fst +++ b/examples/preorders/NatHeap.fst @@ -30,7 +30,7 @@ abstract type ref (a:Type) = nat abstract let contains (#a:Type) (h:heap) (r:ref a) : GTot Type0 = exists x . snd h r == Some (| a , x |) -//NB: is_Some (snd h r), would avoid the existential, but would not capture the type equality +//NB: Some? (snd h r), would avoid the existential, but would not capture the type equality //NB: match snd h r with | Some (| b, _ |) -> a == b | _ -> False // this style would avoid the existential diff --git a/examples/printf/SimplePrintf.fst b/examples/printf/SimplePrintf.fst index d4c74f71508..87bef39b99a 100644 --- a/examples/printf/SimplePrintf.fst +++ b/examples/printf/SimplePrintf.fst @@ -97,9 +97,9 @@ let rec parse_format_pure (s:list char) : Tot (option (list dir)) = let rec parse_format_string (s:string) : Tot (option (list dir)) = parse_format_pure (list_of_string s) -let sprintf (s:string{normalize_term #bool (is_Some (parse_format_string s))}) - : Tot (normalize_term (dir_type (Some.v (parse_format_string s)))) = - string_of_dirs (Some.v (parse_format_string s)) (fun s -> s) +let sprintf (s:string{normalize_term #bool (Some? (parse_format_string s))}) + : Tot (normalize_term (dir_type (Some?.v (parse_format_string s)))) = + string_of_dirs (Some?.v (parse_format_string s)) (fun s -> s) (* trying to make sure that it's not the SMT solver doing the reduction *) #reset-options "--initial_fuel 0 --max_fuel 0" @@ -147,7 +147,7 @@ let example5 : string = (* Take 1: *) (* let example6 : string = *) (* (sprintf "%d=%s" <: int -> string -> Tot string) 42 " answer" *) -(* ./SimplePrintf.fst(140,3-140,18): Subtyping check failed; expected type (uu___:Prims.int -> uu___:Prims.string -> Tot Prims.string); got type (((match (Prims.Some.v (match (FStar.String.list_of_string "%d=%s") with *) +(* ./SimplePrintf.fst(140,3-140,18): Subtyping check failed; expected type (uu___:Prims.int -> uu___:Prims.string -> Tot Prims.string); got type (((match (Prims.Some?.v (match (FStar.String.list_of_string "%d=%s") with *) (* | (Prims.Nil #.uu___#12770) -> (Prims.Some (Prims.Nil )) *) (* |(Prims.Cons #.uu___#12974 % (Prims.Cons #.uu___#12970 c#39352 s'#39353)) -> ((match c@1 with *) (* | % -> (SimplePrintf.add_dir (SimplePrintf.Lit %) (SimplePrintf.parse_format_pure s'@0)) *) @@ -166,7 +166,7 @@ let example5 : string = (* let example6 : string = *) (* sprintf "%d=%s" 42 " answer" *) (* ./SimplePrintf.fst(162,18-162,20) : Error *) -(* Too many arguments to function of type (s:(s#17162:Prims.string{(Prims.eq2 (Prims.is_Some (match (FStar.String.list_of_string s@0) with *) +(* Too many arguments to function of type (s:(s#17162:Prims.string{(Prims.eq2 (Prims.Some? (match (FStar.String.list_of_string s@0) with *) (* | (Prims.Nil #.uu___#12770) -> (Prims.Some (Prims.Nil )) *) (* |(Prims.Cons #.uu___#12974 % (Prims.Cons #.uu___#12970 c#38766 s'#38767)) -> ((match c@1 with *) (* | % -> (SimplePrintf.add_dir (SimplePrintf.Lit %) (SimplePrintf.parse_format_pure s'@0)) *) @@ -176,7 +176,7 @@ let example5 : string = (* |s -> (SimplePrintf.add_dir (SimplePrintf.Arg SimplePrintf.String) (SimplePrintf.parse_format_pure s'@0)) *) (* |_ -> (Prims.None )) : (Prims.option (Prims.list SimplePrintf.dir))) *) (* |(Prims.Cons #.uu___#14938 % (Prims.Nil #.uu___#14934)) -> (Prims.None ) *) -(* |(Prims.Cons #.uu___#15706 c#38769 s'#38770) -> (SimplePrintf.add_dir (SimplePrintf.Lit c@1) (SimplePrintf.parse_format_pure s'@0)))) true)}) -> Tot (((match (Prims.Some.v (match (FStar.String.list_of_string s@0) with *) +(* |(Prims.Cons #.uu___#15706 c#38769 s'#38770) -> (SimplePrintf.add_dir (SimplePrintf.Lit c@1) (SimplePrintf.parse_format_pure s'@0)))) true)}) -> Tot (((match (Prims.Some?.v (match (FStar.String.list_of_string s@0) with *) (* | (Prims.Nil #.uu___#12770) -> (Prims.Some (Prims.Nil )) *) (* |(Prims.Cons #.uu___#12974 % (Prims.Cons #.uu___#12970 c#38755 s'#38756)) -> ((match c@1 with *) (* | % -> (SimplePrintf.add_dir (SimplePrintf.Lit %) (SimplePrintf.parse_format_pure s'@0)) *) diff --git a/examples/printf/SimplePrintfReify.fst b/examples/printf/SimplePrintfReify.fst index b61b6b8d38d..c081ac71b08 100644 --- a/examples/printf/SimplePrintfReify.fst +++ b/examples/printf/SimplePrintfReify.fst @@ -130,7 +130,7 @@ let parse_format_pure (s:list char) : option (list dir) = (* let rec parse_format_string (s:string) : Tot (option (list dir)) = *) (* parse_format_pure (list_of_string s) *) -(* let sprintf (s:string{is_Some (parse_format_string s)}) *) +(* let sprintf (s:string{Some? (parse_format_string s)}) *) (* : Tot (dir_type (Some.v (parse_format_string s))) = *) (* string_of_dirs (Some.v (parse_format_string s)) (fun s -> s) *) diff --git a/examples/relational/IFC.Compiler.fst b/examples/relational/IFC.Compiler.fst index 534d4849712..5419cf039b0 100644 --- a/examples/relational/IFC.Compiler.fst +++ b/examples/relational/IFC.Compiler.fst @@ -85,7 +85,7 @@ let rec tc_com l c = | Seq c1 c2 -> let r1 = tc_com l c1 in let r2 = tc_com l c2 in - if is_None r1 || is_None r2 then + if None? r1 || None? r2 then None else Some (convert_com l (seq_com l (Some.v r1) (Some.v r2))) @@ -96,7 +96,7 @@ let rec tc_com l c = let r1 = sub_exp l1' l1 r1' in let r2 = tc_com l1 ct in let r3 = tc_com l1 cf in - if is_None r2 || is_None r3 then + if None? r2 || None? r3 then None else let s = cond_com l1 r1 (Some.v r2) (Some.v r3) in @@ -107,7 +107,7 @@ let rec tc_com l c = let l1 = max l1' l in let r1 = sub_exp l1' l1 r1' in let r2 = tc_com l1 cb in - if is_None r2 then + if None? r2 then None else let s = loop_com l1 r1 (Some.v r2) in diff --git a/examples/relational/IFC2.IFC.fst b/examples/relational/IFC2.IFC.fst index 8da1e9c75af..368c80450ec 100644 --- a/examples/relational/IFC2.IFC.fst +++ b/examples/relational/IFC2.IFC.fst @@ -259,7 +259,7 @@ let rec tc_com l c = | Seq c1 c2 -> let r1 = tc_com l c1 in let r2 = tc_com l c2 in - if is_None r1 || is_None r2 then + if None? r1 || None? r2 then None else Some (seq_com c1 c2 l (Some.v r1) (Some.v r2)) @@ -270,7 +270,7 @@ let rec tc_com l c = let r1 = sub_exp e l1' l1 r1' in let r2 = tc_com l1 ct in let r3 = tc_com l1 cf in - if is_None r2 || is_None r3 then + if None? r2 || None? r3 then None else let s = cond_com e ct cf l1 r1 (Some.v r2) (Some.v r3) in @@ -282,7 +282,7 @@ let rec tc_com l c = let l1 = max l1' l in let r1 = sub_exp l1' l1 r1' in let r2 = tc_com l1 cb in - if is_None r2 then + if None? r2 then None else let s = loop_com l1 r1 (Some.v r2) in diff --git a/examples/relational/RandomOracle.Encryption.fst b/examples/relational/RandomOracle.Encryption.fst index 96fe44cb689..fe58635d83a 100644 --- a/examples/relational/RandomOracle.Encryption.fst +++ b/examples/relational/RandomOracle.Encryption.fst @@ -49,7 +49,7 @@ opaque val encrypt_hon : k:double key{safe_key_pre k} (ensures (fun h2' p h2 -> goodstate_hash (sel_rel1 h2 s) /\( not (or_irel (rel_map1T (fun s -> s.bad) (sel_rel1 h2 s))) ==> Ok (rel_map1T (fun s -> s.l)(sel_rel1 h2 s)) - /\ is_Some (R.l p) /\ is_Some (R.r p) + /\ Some? (R.l p) /\ Some? (R.r p) /\ snd (Some.v (R.l p)) = snd (Some.v (R.r p)) /\ (fresh_keys (rel_map2T append k (R (snd(Some.v #(block * block) (R.l p))) (snd(Some.v #(block * block) (R.r p))))) @@ -65,9 +65,9 @@ let encrypt_hon k p = let h = hash_hon kh sample_fun in (* Writing the code in this style causes the loss of some typing information *) -(* let c = rel_map3 (fun h p r -> if is_Some h then Some ((encrypt p (Some.v h)), r) else None) h p r in *) - let c = R (if is_Some (R.l h) then Some ((encrypt (R.l p) (Some.v (R.l h))), (R.l r)) else None) - (if is_Some (R.r h) then Some ((encrypt (R.r p) (Some.v (R.r h))), (R.r r)) else None) in +(* let c = rel_map3 (fun h p r -> if Some? h then Some ((encrypt p (Some.v h)), r) else None) h p r in *) + let c = R (if Some? (R.l h) then Some ((encrypt (R.l p) (Some.v (R.l h))), (R.l r)) else None) + (if Some? (R.r h) then Some ((encrypt (R.r p) (Some.v (R.r h))), (R.r r)) else None) in c (* We only show that decryption does not violate our relational invariants *) @@ -83,6 +83,6 @@ let decrypt_hon k c = id_good_sample_fun (); let h = hash_hon kh (fun x -> x) in (* Writing the code in this style causes the loss of some typing information *) -(* rel_map2T (fun h c -> if is_Some h then Some (decrypt (fst c) (Some.v h)) else None) h c *) - R (if is_Some (R.l h) then Some (decrypt (fst (R.l c)) (Some.v (R.l h))) else None) - (if is_Some (R.r h) then Some (decrypt (fst (R.r c)) (Some.v (R.r h))) else None) +(* rel_map2T (fun h c -> if Some? h then Some (decrypt (fst c) (Some.v h)) else None) h c *) + R (if Some? (R.l h) then Some (decrypt (fst (R.l c)) (Some.v (R.l h))) else None) + (if Some? (R.r h) then Some (decrypt (fst (R.r c)) (Some.v (R.r h))) else None) diff --git a/examples/relational/RandomOracle.RO.fst b/examples/relational/RandomOracle.RO.fst index 7d0e4dc9de9..c2e26e8f1d2 100644 --- a/examples/relational/RandomOracle.RO.fst +++ b/examples/relational/RandomOracle.RO.fst @@ -46,17 +46,17 @@ type state_hash = type Ok : double log -> Type = | Null: Ok (twice []) | ConsH: k:double key{safe_key k} -> t:double tag{safe t} - -> l:double log{and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l)} + -> l:double log{and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l)} -> p: Ok l -> Ok (cons_rel (pair_rel k (pair_rel (twice Hon) t)) l) | ConsA: k:eq key -> t:eq tag - -> l:double log{and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l)} + -> l:double log{and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l)} -> p: Ok l -> Ok (cons_rel (pair_rel k (pair_rel (twice Adv) t)) l) (* keys are fresh if they are not in the hash function's log yet *) val fresh_keys : k:double key -> l:double log -> Tot bool -let fresh_keys k l = and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l) +let fresh_keys k l = and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l) (* We need these lemmas to use our inductive datatype Ok without having access to an element of Ok l (it exists only in refinements) *) @@ -65,7 +65,7 @@ assume val ok_as_proof : l: double log{Ok l} -> Tot (Ok l) val ok_consH : k:double key{safe_key k} -> t:double tag{safe t} - -> l:double log{and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l) + -> l:double log{and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l) /\ Ok l} -> Lemma (requires True) (ensures Ok (cons_rel (pair_rel k (pair_rel (twice Hon) t)) l)) @@ -73,7 +73,7 @@ let ok_consH k t l = ok_as_refinement(ConsH k t l (ok_as_proof l)) val ok_consA : k:eq key -> t:eq tag - -> l:double log{and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l) + -> l:double log{and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l) /\ Ok l} -> Lemma (requires True) (ensures Ok (cons_rel (pair_rel k (pair_rel (twice Adv) t)) l)) @@ -104,8 +104,8 @@ let ok_adv_eq k l = ok_adv_eq' k l (ok_as_proof l) val ok_hon_safe' : k:double key -> l:double log -> p:Ok l -> Lemma (requires (safe_key k)) - (ensures ( (is_Some(assoc (R.l k) (R.l l)) /\ is_Hon(fst (Some.v(assoc (R.l k) (R.l l))))) <==> - is_Some(assoc (R.r k) (R.r l)) /\ is_Hon(fst (Some.v(assoc (R.r k) (R.r l)))))) + (ensures ( (Some?(assoc (R.l k) (R.l l)) /\ Hon?(fst (Some.v(assoc (R.l k) (R.l l))))) <==> + Some?(assoc (R.r k) (R.r l)) /\ Hon?(fst (Some.v(assoc (R.r k) (R.r l)))))) (decreases (R.l l)) let rec ok_hon_safe' k l p = match p with | Null -> () @@ -119,8 +119,8 @@ let rec ok_hon_safe' k l p = match p with val ok_hon_safe : k:double key -> l:double log{Ok l} -> Lemma (requires (safe_key k)) - (ensures ( (is_Some(assoc (R.l k) (R.l l)) /\ is_Hon(fst (Some.v(assoc (R.l k) (R.l l))))) <==> - is_Some(assoc (R.r k) (R.r l)) /\ is_Hon(fst (Some.v(assoc (R.r k) (R.r l)))))) + (ensures ( (Some?(assoc (R.l k) (R.l l)) /\ Hon?(fst (Some.v(assoc (R.l k) (R.l l))))) <==> + Some?(assoc (R.r k) (R.r l)) /\ Hon?(fst (Some.v(assoc (R.r k) (R.r l)))))) let ok_hon_safe k l = ok_hon_safe' k l (ok_as_proof l) @@ -129,9 +129,9 @@ let ok_hon_safe k l = ok_hon_safe' k l (ok_as_proof l) val ok_hon_safe2' : k:double key -> l:double log -> p:Ok l -> Lemma (requires (safe_key k)) - (ensures (is_Some(assoc (R.l k) (R.l l)) /\ is_Some(assoc (R.r k) (R.r l)) /\ - is_Hon(fst(Some.v (assoc (R.l k) (R.l l)))) /\ - is_Hon(fst(Some.v (assoc (R.r k) (R.r l)))) ==> + (ensures (Some?(assoc (R.l k) (R.l l)) /\ Some?(assoc (R.r k) (R.r l)) /\ + Hon?(fst(Some.v (assoc (R.l k) (R.l l)))) /\ + Hon?(fst(Some.v (assoc (R.r k) (R.r l)))) ==> safe (R (snd(Some.v (assoc (R.l k) (R.l l)))) (snd(Some.v (assoc (R.r k) (R.r l))))))) (decreases (R.l l)) @@ -147,9 +147,9 @@ let rec ok_hon_safe2' k l p = match p with val ok_hon_safe2 : k:double key -> l:double log{Ok l} -> Lemma (requires (safe_key k)) - (ensures (is_Some(assoc (R.l k) (R.l l)) /\ is_Some(assoc (R.r k) (R.r l)) /\ - is_Hon(fst(Some.v (assoc (R.l k) (R.l l)))) /\ - is_Hon(fst(Some.v (assoc (R.r k) (R.r l)))) ==> + (ensures (Some?(assoc (R.l k) (R.l l)) /\ Some?(assoc (R.r k) (R.r l)) /\ + Hon?(fst(Some.v (assoc (R.l k) (R.l l)))) /\ + Hon?(fst(Some.v (assoc (R.r k) (R.r l)))) ==> safe (R (snd(Some.v (assoc (R.l k) (R.l l)))) (snd(Some.v (assoc (R.r k) (R.r l))))))) let ok_hon_safe2 k l = ok_hon_safe2' k l (ok_as_proof l) @@ -169,7 +169,7 @@ opaque val hash_hon: k:double key -> f:(tag -> Tot tag){good_sample_fun #tag #t safe_key k)) (ensures (fun h2' p h2 -> goodstate_hash (sel_rel1 h2 s) /\ (not (or_irel (rel_map1T (fun s -> s.bad) (sel_rel1 h2 s))) ==> - (is_Some (R.l p) /\ is_Some (R.r p) + (Some? (R.l p) /\ Some? (R.r p) /\ safe (R (Some.v(R.l p)) (Some.v(R.r p))) /\ (fresh_keys k (rel_map1T (fun s -> s.l) (sel_rel1 h2' s)) ==> Some.v #tag (R.r p) = f (Some.v #tag (R.l p))) @@ -181,7 +181,7 @@ opaque val hash_hon2: k:double key -> f:(tag -> Tot tag){good_sample_fun #tag # safe_key k)) (ensures (fun h2' p h2 -> goodstate_hash (sel_rel1 h2 s) /\ (not (or_irel (rel_map1T (fun s -> s.bad) (sel_rel1 h2 s))) ==> - (is_Some (R.l p) /\ is_Some (R.r p) + (Some? (R.l p) /\ Some? (R.r p) /\ safe (R (Some.v(R.l p)) (Some.v(R.r p))) /\ (fresh_keys k (rel_map1T (fun s -> s.l) (sel_rel1 h2' s)) ==> Some.v #tag (R.r p) = f (Some.v #tag (R.l p))) @@ -192,7 +192,7 @@ opaque val hash_adv: k:eq key -> (requires (fun h2 -> goodstate_hash (sel_rel1 h2 s))) (ensures (fun h2' p h2 -> goodstate_hash (sel_rel1 h2 s) /\ (or_irel (rel_map1T (fun s -> s.bad) (sel_rel1 h2 s)) \/ - is_Some (R.l p) /\ is_Some (R.r p) /\ + Some? (R.l p) /\ Some? (R.r p) /\ Some.v(R.l p) = Some.v(R.r p) /\ Ok (rel_map1T (fun s -> s.l)(sel_rel1 h2 s))))) @@ -231,10 +231,10 @@ let hash_hon k f = let s = compose2_self (fun s -> !s) (twice s)in good_sample_fun_bijection #tag #tag f; if (not (or_irel (rel_map1T (fun s -> s.bad) s))) then - if and_irel (rel_map1T is_Some t) then + if and_irel (rel_map1T Some? t) then (ok_hon_safe k l; ok_hon_safe2 k l; - if and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l) then + if and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l) then ok_consH k (R (Some.v (R.l t)) (Some.v (R.r t))) l); t @@ -302,9 +302,9 @@ let hash_adv k = let s = compose2_self (fun s -> !s) (twice s) in (pair_rel k r) in if (not (or_irel (rel_map1T (fun s -> s.bad) s))) then - if and_irel (rel_map1T is_Some t) then + if and_irel (rel_map1T Some? t) then (ok_adv_eq k l; - if and_irel (rel_map2T (fun k l -> is_None (assoc k l)) k l) then + if and_irel (rel_map2T (fun k l -> None? (assoc k l)) k l) then ok_consA k (R (Some.v (R.l t)) (Some.v (R.r t))) l); t diff --git a/examples/relational/cache.fst b/examples/relational/cache.fst index 99c93f1449f..99598fcfae5 100644 --- a/examples/relational/cache.fst +++ b/examples/relational/cache.fst @@ -51,7 +51,7 @@ type fac_cache = list (nat * nat) assume val cache : ref fac_cache (* An invariant on the correctness of the cache *) -type fac_cache_correct (c:fac_cache) = (forall x. is_Some (assoc x c) ==> (Some.v (assoc x c) = fac x)) +type fac_cache_correct (c:fac_cache) = (forall x. Some? (assoc x c) ==> (Some.v (assoc x c) = fac x)) (* A cached version of the factorial computation *) val fac_cached : x:nat -> ST nat (requires (fun h -> fac_cache_correct (sel h cache) @@ -62,7 +62,7 @@ val fac_cached : x:nat -> ST nat (requires (fun h -> fac_cache_correct (sel h ca let fac_cached x = let c = !cache in let l = assoc x c in - if is_Some l then + if Some? l then Some.v l else( let v = fac x in diff --git a/examples/relational/ifc.fst b/examples/relational/ifc.fst index 619925b58e3..08ffdb8763c 100644 --- a/examples/relational/ifc.fst +++ b/examples/relational/ifc.fst @@ -45,7 +45,7 @@ type ni_exp (env:label_fun) (e:exp) (l:label) = double unit -> ST2 (double int) /\ equal (R.r h0) (R.r h1) /\ R.l r = interpret_exp (R.l h0) e /\ R.r r = interpret_exp (R.r h0) e - /\ (low_equiv env h0 /\ is_Low l ==> R.l r = R.r r))) + /\ (low_equiv env h0 /\ Low? l ==> R.l r = R.r r))) (* env,pc:l |- c @@ -61,9 +61,9 @@ type ni_com (env:label_fun) (c:com) (l:label) = double unit -> ST2 (double unit) ==> sel (R.l h0) r = sel (R.l h1) r /\ sel (R.r h0) r = sel (R.r h1) r) /\ Let (interpret_com (R.l h0) c) (fun o -> - is_Some o ==> equal (Some.v o) (R.l h1)) + Some? o ==> equal (Some.v o) (R.l h1)) /\ Let (interpret_com (R.r h0) c) (fun o -> - is_Some o ==> equal (Some.v o) (R.r h1)) + Some? o ==> equal (Some.v o) (R.r h1)) /\ (low_equiv env h0 ==> low_equiv env h1))) @@ -194,13 +194,13 @@ val loop_loop : env:label_fun -> e:exp -> c:com -> v:variant -> l:label ==> sel (R.l h0) r = sel (R.l h1) r /\ sel (R.r h0) r = sel (R.r h1) r) /\ Let (interpret_com (R.l h0) c) (fun o -> - is_Some o ==> + Some? o ==> Let (interpret_com (Some.v o) (While e c v)) (fun o -> - is_Some o ==> equal (Some.v o) (R.l h1))) + Some? o ==> equal (Some.v o) (R.l h1))) /\ Let (interpret_com (R.r h0) c) (fun o -> - is_Some o ==> + Some? o ==> Let (interpret_com (Some.v o) (While e c v)) (fun o -> - is_Some o ==> equal (Some.v o) (R.r h1))) + Some? o ==> equal (Some.v o) (R.r h1))) /\ (low_equiv env h0 ==> low_equiv env h1))) (* While rule for commands @@ -220,9 +220,9 @@ val loop_com : env:label_fun -> e:exp -> c:com -> v:variant -> l:label ==> sel (R.l h0) r = sel (R.l h1) r /\ sel (R.r h0) r = sel (R.r h1) r) /\ Let (interpret_com (R.l h0) (While e c v)) (fun o -> - is_Some o ==> equal (Some.v o) (R.l h1)) + Some? o ==> equal (Some.v o) (R.l h1)) /\ Let (interpret_com (R.r h0) (While e c v)) (fun o -> - is_Some o ==> equal (Some.v o) (R.r h1)) + Some? o ==> equal (Some.v o) (R.r h1)) /\ (low_equiv env h0 ==> low_equiv env h1))) let rec loop_com env e c v l e_ni c_ni _ = @@ -278,7 +278,7 @@ let rec tc_com env l c = | Seq c1 c2 -> let r1 = tc_com env l c1 in let r2 = tc_com env l c2 in - if is_None r1 || is_None r2 then + if None? r1 || None? r2 then None else Some (seq_com env c1 c2 l (Some.v r1) (Some.v r2)) @@ -289,7 +289,7 @@ let rec tc_com env l c = let r1 = sub_exp env e l1' l1 r1' in let r2 = tc_com env l1 ct in let r3 = tc_com env l1 cf in - if is_None r2 || is_None r3 then + if None? r2 || None? r3 then None else let s = cond_com env e ct cf l1 r1 (Some.v r2) (Some.v r3) in @@ -300,7 +300,7 @@ let rec tc_com env l c = let l1 = if l1' <= l then l else l1' in let r1 = sub_exp env e l1' l1 r1' in let r2 = tc_com env l1 cb in - if is_None r2 then + if None? r2 then None else let s = loop_com env e cb v l1 r1 (Some.v r2) in diff --git a/examples/relational/ifc_global_env.fst b/examples/relational/ifc_global_env.fst index 18d6d9a729b..2aa8a74c7d5 100644 --- a/examples/relational/ifc_global_env.fst +++ b/examples/relational/ifc_global_env.fst @@ -77,9 +77,9 @@ type ni_com (c:com) (l:label) = ==> sel (R.l h1) y = sel (R.l h2) y /\ sel (R.r h1) y = sel (R.r h2) y) /\ Let (interpret_com (R.l h1) c) - (fun o -> is_Some o ==> equal (R.l h2) (Some.v o)) + (fun o -> Some? o ==> equal (R.l h2) (Some.v o)) /\ Let (interpret_com (R.r h1) c) - (fun o -> is_Some o ==> equal (R.r h2) (Some.v o)) + (fun o -> Some? o ==> equal (R.r h2) (Some.v o)) /\ (a_equiv h1 ==> a_equiv h2))) (* We define noninterference for a program as noninterference for commands with @@ -190,14 +190,14 @@ val loop_loop : ae:exp -> com:com ->v:variant -> l:label -> =e:(ni_exp ae l) -> /\ sel (R.r h1) y = sel (R.r h2) y) /\ Let (interpret_com (R.l h1) com) - (fun o -> is_Some o ==> + (fun o -> Some? o ==> (Let (interpret_com (Some.v o)(While ae com v)) - (fun o -> is_Some o ==> equal (R.l h2) (Some.v o)))) + (fun o -> Some? o ==> equal (R.l h2) (Some.v o)))) /\ Let (interpret_com (R.r h1) com) - (fun o -> is_Some o ==> + (fun o -> Some? o ==> (Let (interpret_com (Some.v o)(While ae com v)) - (fun o -> is_Some o ==> equal (R.r h2) (Some.v o)))) + (fun o -> Some? o ==> equal (R.r h2) (Some.v o)))) /\ (a_equiv h1 ==> a_equiv h2))) @@ -218,9 +218,9 @@ val loop_com : ae:exp -> com:com ->v:variant -> l:label -> =e:(ni_exp ae l) -> = ==> sel (R.l h1) y = sel (R.l h2) y /\ sel (R.r h1) y = sel (R.r h2) y) /\ Let (interpret_com (R.l h1) (While ae com v)) - (fun o -> is_Some o ==> equal (R.l h2) (Some.v o)) + (fun o -> Some? o ==> equal (R.l h2) (Some.v o)) /\ Let (interpret_com (R.r h1) (While ae com v)) - (fun o -> is_Some o ==> equal (R.r h2) (Some.v o)) + (fun o -> Some? o ==> equal (R.r h2) (Some.v o)) /\ (a_equiv h1 ==> a_equiv h2))) let rec loop_com ae com v l e c tu = match e tu with @@ -273,7 +273,7 @@ let rec tc_com l c = | Seq c1 c2 -> let r1 = tc_com l c1 in let r2 = tc_com l c2 in - if is_None r1 || is_None r2 then + if None? r1 || None? r2 then None else Some (seq_com c1 c2 l (Some.v r1) (Some.v r2)) @@ -284,7 +284,7 @@ let rec tc_com l c = let r1 = sub_exp e l1' l1 r1' in let r2 = tc_com l1 ct in let r3 = tc_com l1 cf in - if is_None r2 || is_None r3 then + if None? r2 || None? r3 then None else let s = cond_com e ct cf l1 r1 (Some.v r2) (Some.v r3) in @@ -295,7 +295,7 @@ let rec tc_com l c = let l1 = max l1' l in let r1 = sub_exp e l1' l1 r1' in let r2 = tc_com l1 cb in - if is_None r2 then + if None? r2 then None else let s = loop_com e cb v l1 r1 (Some.v r2) in diff --git a/examples/relational/new/ifc.fst b/examples/relational/new/ifc.fst index abe23da5b10..a7014d6c69b 100644 --- a/examples/relational/new/ifc.fst +++ b/examples/relational/new/ifc.fst @@ -25,7 +25,7 @@ let op_Less_Equals l1 l2 = type label_fun = ref int -> Tot label type low_equiv (env:label_fun) (h1:rel heap) = - forall (x:ref int). env x = Low ==> sel (R.l h1) x = sel (R.r h1) x + forall (x:ref int). env x = Low ==> sel (R?.l h1) x = sel (R?.r h1) x (**************************** Typing Judgements ****************************) @@ -38,8 +38,8 @@ type low_equiv (env:label_fun) (h1:rel heap) = type ni_exp (env:label_fun) (e:exp) (l:label) = forall (h: (rel heap)). - (low_equiv env h /\ is_Low l) ==> - (interpret_exp (R.r h) e = interpret_exp (R.l h) e) + (low_equiv env h /\ Low? l) ==> + (interpret_exp (R?.r h) e = interpret_exp (R?.l h) e) (* env,pc:l |- c - References with a label below l are not modified @@ -47,34 +47,34 @@ type ni_exp (env:label_fun) (e:exp) (l:label) = - Low equivalent input heaps ==> Low equivalet output heaps *) type ni_com' (env:label_fun) (c:com) (l:label) (h0:(rel (option heap))) = - (is_Some (R.l h0) /\ is_Some (R.r h0) ==> + (Some? (R?.l h0) /\ Some? (R?.r h0) ==> (fun h0 -> (fun o_l -> (fun o_r -> - ((is_Some o_l /\ is_Some o_r) + ((Some? o_l /\ Some? o_r) ==> (low_equiv env h0 - ==> low_equiv env (R (Some.v o_l) (Some.v o_r))))) - (interpret_com (R.r h0) c)) - (interpret_com (R.l h0) c)) - (R (Some.v (R.l h0)) (Some.v (R.r h0)))) + ==> low_equiv env (R (Some?.v o_l) (Some?.v o_r))))) + (interpret_com (R?.r h0) c)) + (interpret_com (R?.l h0) c)) + (R (Some?.v (R?.l h0)) (Some?.v (R?.r h0)))) /\ - (is_Some (R.l h0) ==> + (Some? (R?.l h0) ==> (fun hl -> (fun o_l -> (forall r. (env r < l) - ==> (is_Some o_l - ==> b2t (sel hl r = sel (Some.v o_l) r)))) + ==> (Some? o_l + ==> b2t (sel hl r = sel (Some?.v o_l) r)))) (interpret_com hl c)) - ((Some.v (R.l h0)))) + ((Some?.v (R?.l h0)))) /\ - (is_Some (R.r h0) ==> + (Some? (R?.r h0) ==> (fun hr -> (fun o_r -> (forall r. (env r < l) - ==> (is_Some o_r - ==> b2t (sel hr r = sel (Some.v o_r) r)))) + ==> (Some? o_r + ==> b2t (sel hr r = sel (Some?.v o_r) r)))) (interpret_com hr c)) - ((Some.v (R.r h0)))) + ((Some?.v (R?.r h0)))) type ni_com (env:label_fun) (c:com) (l:label) = forall (h0:(rel (option heap))). ni_com' env c l h0 @@ -226,7 +226,7 @@ let decr_while h v = match h with val loop_com' : env:label_fun -> e:exp -> c:com -> v:variant -> l:label -> h:(rel (option heap)) -> Lemma (requires (ni_exp env e l /\ ni_com env c l)) (ensures (ni_com' env (While e c v) l h)) - (decreases (decr_while (R.l h) v + decr_while (R.r h) v)) + (decreases (decr_while (R?.l h) v + decr_while (R?.r h) v)) (* Probably not the best solution... *) [SMTPat (true)] let rec loop_com' env e c v l h = diff --git a/examples/relational/new/random_tapes.fst b/examples/relational/new/random_tapes.fst index 4338205692c..71857091adf 100644 --- a/examples/relational/new/random_tapes.fst +++ b/examples/relational/new/random_tapes.fst @@ -10,7 +10,7 @@ type random_tape = int -> Tot int val sample : random_tape -> int -> Tot int let sample r i = r i -type rel_random_tape (b:(int -> Tot bij)) = r:(rel random_tape){forall i. b i (R.l r i) = R.r r i} +type rel_random_tape (b:(int -> Tot bij)) = r:(rel random_tape){forall i. b i (R?.l r i) = R?.r r i} val id : bij #int #int let id x = x @@ -29,7 +29,7 @@ let otp n r i = n + r i (* Random tape used for relational verification *) val otp_rand : x:(rel int) -> int -> Tot (bij #int #int) let otp_rand x i = if i = 0 then - add (R.l x - R.r x) + add (R?.l x - R?.r x) else id @@ -45,8 +45,8 @@ let otp2 n m r i j = (n + r i, m + r j) val otp2_rand : x:(rel int) -> y:(rel int) -> int -> Tot (bij #int #int) let otp2_rand x y i = match i with - | 0 -> add (R.l x - R.r x) - | 1 -> add (R.l y - R.r y) + | 0 -> add (R?.l x - R?.r x) + | 1 -> add (R?.l y - R?.r y) | _ -> id val otp2_eq : x:(rel int) -> y:(rel int) -> r:(rel_random_tape (otp2_rand x y)) -> diff --git a/examples/relational/new/rel.fst b/examples/relational/new/rel.fst index d4a8de2bd66..fea0950c010 100644 --- a/examples/relational/new/rel.fst +++ b/examples/relational/new/rel.fst @@ -4,7 +4,7 @@ module Rel type rel (t:Type) = | R : l:t -> r:t -> rel t -type eq (t:Type) = v:(rel t){R.l v == R.r v} +type eq (t:Type) = v:(rel t){R?.l v == R?.r v} val lift : #t:Type -> #t2:Type -> f:(t -> Tot t2) -> rel t diff --git a/examples/relational/new/whilelanguage.fst b/examples/relational/new/whilelanguage.fst index 3e146915a84..3f224b72e60 100644 --- a/examples/relational/new/whilelanguage.fst +++ b/examples/relational/new/whilelanguage.fst @@ -55,7 +55,7 @@ let decr h c = | _ -> 0 (* Returns Some heap if the variant is correct *) -val interpret_while : h:heap -> c:com{is_While c} +val interpret_while : h:heap -> c:com{While? c} -> GTot (option heap) (decreases %[c; decr h c; 0]) val interpret_com : h:heap -> c:com -> GTot (option heap) (decreases %[c; decr h c; 1]) @@ -105,7 +105,7 @@ let rec interpret_exp_st e = val interpret_com_st : c:com -> ST unit (requires (fun _ -> True)) (ensures (fun h _ h' -> - (fun o -> is_Some o ==> equal h' (Some.v o)) + (fun o -> Some? o ==> equal h' (Some?.v o)) (interpret_com h c) )) let rec interpret_com_st c = match c with diff --git a/examples/relational/ro_single.fst b/examples/relational/ro_single.fst index 9919a089139..f3a35c7707f 100644 --- a/examples/relational/ro_single.fst +++ b/examples/relational/ro_single.fst @@ -21,8 +21,8 @@ type state_hash = type log_monotone (s':state_hash) (s:state_hash) = (s'.bad ==> s.bad) /\ - (forall x. is_Some (assoc x s'.l) ==> - is_Some (assoc x s.l) /\ Some.v (assoc x s.l) = Some.v (assoc x s'.l)) + (forall x. Some? (assoc x s'.l) ==> + Some? (assoc x s.l) /\ Some.v (assoc x s.l) = Some.v (assoc x s'.l)) assume val s : ref state_hash @@ -34,7 +34,7 @@ val hash_hon : k:key -> ST (option tag) (requires (fun h -> True)) (ensures (fun h' r h -> log_monotone (sel h' s) (sel h s) /\ ((sel h s).bad \/ - is_Some r /\ is_Some (assoc k (sel h s).l) /\ + Some? r /\ Some? (assoc k (sel h s).l) /\ Some.v #tag r = snd (Some.v (assoc k (sel h s).l))))) let hash_hon k = match assoc k (!s).l with | Some (Hon, t) -> Some t @@ -47,7 +47,7 @@ val hash_adv : k:key -> ST (option tag) (requires (fun h -> True)) (ensures (fun h' r h -> log_monotone (sel h' s) (sel h s) /\ ((sel h s).bad \/ - is_Some r /\ is_Some (assoc k (sel h s).l) /\ + Some? r /\ Some? (assoc k (sel h s).l) /\ Some.v #tag r = snd (Some.v (assoc k (sel h s).l))))) let hash_adv k = match assoc k (!s).l with | Some (Adv, t) -> Some t @@ -69,16 +69,16 @@ val encrypt_hon : k:bytes -> p:block (requires (fun h -> True)) (ensures (fun h' r h -> log_monotone (sel h' s) (sel h s) /\ ((~ (sel h s).bad) ==> - is_Some r /\ - is_Some (assoc (append k (snd #block #block (Some.v r))) (sel h s).l) /\ + Some? r /\ + Some? (assoc (append k (snd #block #block (Some.v r))) (sel h s).l) /\ encrypt p (snd (Some.v (assoc (append k (snd #block #block (Some.v r))) (sel h s).l))) = fst (Some.v r)))) let encrypt_hon k p = let r = sample () in let kh = append k r in let h = hash_hon kh in let st = !s in - let a = if is_Some h then( - assert(st.bad \/ is_Some(assoc kh st.l)); + let a = if Some? h then( + assert(st.bad \/ Some?(assoc kh st.l)); Some ((encrypt p (Some.v h)), r)) else None in a @@ -88,13 +88,13 @@ val decrypt_hon : k:bytes -> c:(block * block) (requires (fun h -> True)) (ensures (fun h' r h -> log_monotone (sel h' s) (sel h s) /\ ((~ (sel h s).bad /\ - is_Some (assoc(append k (snd c)) (sel h' s).l) - ==> is_Some r /\ + Some? (assoc(append k (snd c)) (sel h' s).l) + ==> Some? r /\ Some.v #block r = decrypt (fst c) (snd (Some.v (assoc (append k (snd c)) (sel h s).l))))))) let decrypt_hon k (c, r) = let kh = append k r in let h = hash_hon kh in - let a = if is_Some h then Some (decrypt c (Some.v h)) else None in + let a = if Some? h then Some (decrypt c (Some.v h)) else None in a val correctness : k:bytes -> p:block -> ST unit @@ -109,8 +109,8 @@ assume val arbitrary_actions : unit -> let correctness k p = let c = encrypt_hon k p in arbitrary_actions (); - if is_Some c then + if Some? c then let p' = decrypt_hon k (Some.v c) in let st = !s in if not (st.bad) then - assert(is_Some p' /\ p = Some.v p') + assert(Some? p' /\ p = Some.v p') diff --git a/examples/relational/smart_meter.fst b/examples/relational/smart_meter.fst index 0f51f1b3c6b..b84606fe0ae 100644 --- a/examples/relational/smart_meter.fst +++ b/examples/relational/smart_meter.fst @@ -101,9 +101,9 @@ let thd3=MkTuple3._3 assume logic type readings (l:double (list int)) assume logic type rates (l:double (list int)) -assume ReadingsTail : (forall l. is_Cons (R.l l) /\ is_Cons (R.r l) +assume ReadingsTail : (forall l. Cons? (R.l l) /\ Cons? (R.r l) ==> readings (tl_rel l)) -assume RatesTail : (forall l. is_Cons (R.l l) /\ is_Cons (R.r l) +assume RatesTail : (forall l. Cons? (R.l l) /\ Cons? (R.r l) ==> rates (tl_rel l)) type signed (pp:pparam) (cs:double (list elt)) = diff --git a/examples/relational/while.fst b/examples/relational/while.fst index fc897b0f3cb..f8484e58144 100644 --- a/examples/relational/while.fst +++ b/examples/relational/while.fst @@ -53,7 +53,7 @@ let decr h c = | _ -> 0 (* Returns Some heap if the variant is correct *) -val interpret_while : h:heap -> c:com{is_While c} +val interpret_while : h:heap -> c:com{While? c} -> Tot (option heap) (decreases %[c; decr h c; 0]) val interpret_com : h:heap -> c:com -> Tot (option heap) (decreases %[c; decr h c; 1]) @@ -103,7 +103,7 @@ val interpret_com_st : c:com -> ST unit (requires (fun _ -> True)) (ensures (fun h _ h' -> Let (interpret_com h c) (fun o -> - is_Some o ==> equal h' (Some.v o)))) + Some? o ==> equal h' (Some.v o)))) let rec interpret_com_st c = match c with | Skip -> () diff --git a/examples/software_foundations/sf-lists.fst b/examples/software_foundations/sf-lists.fst index d121a66a66a..29a2bf403eb 100644 --- a/examples/software_foundations/sf-lists.fst +++ b/examples/software_foundations/sf-lists.fst @@ -73,7 +73,7 @@ val tl_strange_length_pred : l:ilist{l =!= Nil} -> Lemma (ensures ((length l) - 1 = length (tl_strange l))) let tl_strange_length_pred l = () -val tl_strange_length_pred_equiv : l:ilist{is_Cons l} -> Lemma +val tl_strange_length_pred_equiv : l:ilist{Cons? l} -> Lemma (ensures ((length l) - 1 = length (tl_strange l))) let tl_strange_length_pred_equiv l = () diff --git a/examples/test/ordmap.fst b/examples/test/ordmap.fst index 351c22f65b3..9f4b8ecf415 100644 --- a/examples/test/ordmap.fst +++ b/examples/test/ordmap.fst @@ -21,7 +21,7 @@ let rec mem x = function | hd::tl -> if hd = x then true else mem x tl type map_t (k:Type) (v:Type) (f:cmp k) (d:ordset k f) = - g:(k -> Tot (option v)){(forall x. (mem x d = is_Some (g x)))} + g:(k -> Tot (option v)){(forall x. (mem x d = Some? (g x)))} type ordmap: key:Type -> value:Type -> cmp key -> Type = | Mk_map: #k:Type -> #v:Type -> #f:cmp k -> d:ordset k f -> m:map_t k v f d -> ordmap k v f @@ -36,13 +36,13 @@ let contains (#k:Type) (#v:Type) #f x (Mk_map s g) = mem x s val sel_contains: #k:Type -> #v:Type -> #f:cmp k -> x:k -> m:ordmap k v f -> Lemma (requires (True)) - (ensures (contains #k #v #f x m = is_Some (select #k #v #f x m))) + (ensures (contains #k #v #f x m = Some? (select #k #v #f x m))) #reset-options let sel_contains (#k:Type) (#v:Type) #f x m = () (* intuitive proof: - contains #k #v #f x m = mem x (Mk_map.d m) - - is_Some (select #k #v #f x m) = is_Some ((Mk_map.m m) x) - - by map_t type: forall x. (mem x d = is_Some (g x))) + - Some? (select #k #v #f x m) = Some? ((Mk_map.m m) x) + - by map_t type: forall x. (mem x d = Some? (g x))) *) diff --git a/examples/unit-tests/NegativeTests.BST.fst b/examples/unit-tests/NegativeTests.BST.fst index 4575a8669d6..21da4b1cf16 100644 --- a/examples/unit-tests/NegativeTests.BST.fst +++ b/examples/unit-tests/NegativeTests.BST.fst @@ -9,8 +9,8 @@ type tree: int -> Type = -> #r :int -> right:option (tree r){l <= n /\ n <= r - /\ (is_None right <==> n=r) - /\ (is_None left <==> n=l)} + /\ (None? right <==> n=r) + /\ (None? left <==> n=l)} -> tree r diff --git a/examples/unit-tests/NegativeTests.Neg.fst b/examples/unit-tests/NegativeTests.Neg.fst index 4f402116d00..f20e9009ea3 100644 --- a/examples/unit-tests/NegativeTests.Neg.fst +++ b/examples/unit-tests/NegativeTests.Neg.fst @@ -29,7 +29,7 @@ val bad_projector: option 'a -> 'a let bad_projector x = Some.v x (* should fail *) assume type T : (result int -> Type) -> Type -assume TEST: T (fun ri -> b2t (V.v ri = 0))//should fail: not (is_V ri) +assume TEST: T (fun ri -> b2t (V.v ri = 0))//should fail: not (V? ri) assume val f1: (x:int -> Tot unit) -> Tot unit assume val g1: nat -> Tot unit diff --git a/examples/unit-tests/Unit1.Basic.fst b/examples/unit-tests/Unit1.Basic.fst index 9840089b811..3d70cf27bbf 100644 --- a/examples/unit-tests/Unit1.Basic.fst +++ b/examples/unit-tests/Unit1.Basic.fst @@ -44,7 +44,7 @@ let hd_int_impure_default_case l = match l with | hd::_ -> hd | _ -> failwith "Empty list" -val hd_int_pure : x:list int{is_Cons x} -> Tot int +val hd_int_pure : x:list int{Cons? x} -> Tot int let hd_int_pure l = match l with | hd::_ -> hd @@ -80,7 +80,7 @@ let tabs_id (a:Type) (x:'a) = x val id_pure_annot_eq : x:'a -> Pure 'a True (fun y -> b2t (y=x)) let id_pure_annot_eq x = x -val id_all_annot_eq: x:'a -> All 'a (fun h -> True) (fun h0 y h1 -> is_V y /\ h0=h1 /\ x=(V.v y)) +val id_all_annot_eq: x:'a -> All 'a (fun h -> True) (fun h0 y h1 -> V? y /\ h0=h1 /\ x=(V?.v y)) let id_all_annot_eq x = x val hd: list 'a -> 'a @@ -88,11 +88,11 @@ let hd = function | x::_ -> x | _ -> failwith "empty list" -val hd_pure: l:list 'a{is_Cons l} -> Tot 'a +val hd_pure: l:list 'a{Cons? l} -> Tot 'a let hd_pure l = match l with | x::_ -> x -val hd_pure_alt: x:list 'a{is_Cons x} -> Tot 'a +val hd_pure_alt: x:list 'a{Cons? x} -> Tot 'a let hd_pure_alt = function | hd::_ -> hd @@ -183,7 +183,7 @@ let do_ok l = match l with | N -> N | C(n, l') -> if n = 0 then l else C(0, l') -val short_circuit1: x:option int{is_Some x /\ Some.v x = 0} -> nat +val short_circuit1: x:option int{Some? x /\ Some.v x = 0} -> nat let short_circuit1 x = Some.v x (* TESTING skolem variables for lambdas *) @@ -211,7 +211,7 @@ let rec find f = function val test_skolem_let: x:int -> Tot (b:bool{b ==> x=0}) let test_skolem_let x = let found = find (fun y -> x=0) [x] in - is_Some found + Some? found (* TESTING implicit binding of conditionally total function arguments *) assume val id_wrap1: x:int -> Pure int (requires True) (ensures (fun y -> x=y)) diff --git a/examples/unit-tests/Unit1.RefinementInference.fst b/examples/unit-tests/Unit1.RefinementInference.fst index b04f8a032d5..86538d35e96 100644 --- a/examples/unit-tests/Unit1.RefinementInference.fst +++ b/examples/unit-tests/Unit1.RefinementInference.fst @@ -1,8 +1,8 @@ module Unit1.RefinementInference type erased : Type -> Type assume val reveal: erased 'a -> GTot 'a -assume val consHd : #a:Type -> l:list a{is_Cons l} -> Tot a +assume val consHd : #a:Type -> l:list a{Cons? l} -> Tot a assume val elift1_p : #a:Type -> #b:Type -> #p:(a->Type) -> =f:(=x:a{p x} ->Tot b) -> r:erased a{p (reveal r) } -> Tot (erased b) -val ghostConsHd : a:Type -> l:erased (list a){is_Cons (reveal l)} -> Tot (erased a) +val ghostConsHd : a:Type -> l:erased (list a){Cons? (reveal l)} -> Tot (erased a) let ghostConsHd (a:Type) l = elift1_p consHd l diff --git a/examples/unit-tests/listTot.fst b/examples/unit-tests/listTot.fst index de8766a74e5..ed9915fef77 100644 --- a/examples/unit-tests/listTot.fst +++ b/examples/unit-tests/listTot.fst @@ -22,11 +22,11 @@ let isEmpty l = match l with | [] -> true | _ -> false -val hd: l:list 'a{is_Cons l} -> Tot 'a +val hd: l:list 'a{Cons? l} -> Tot 'a let hd = function | hd::_ -> hd -val tl: l:list 'a {is_Cons l} -> Tot (list 'a) +val tl: l:list 'a {Cons? l} -> Tot (list 'a) let tl = function | _::tl -> tl diff --git a/examples/unit-tests/mac.fst b/examples/unit-tests/mac.fst index 44e9bdf3890..c8c6a7dfbc8 100644 --- a/examples/unit-tests/mac.fst +++ b/examples/unit-tests/mac.fst @@ -75,7 +75,7 @@ let mac k t = let verify k text tag = let verified = sha1verify k text tag in - let found = is_Some(List.Tot.find (function (Entry k' text' tag') -> k=k' && text=text' (*CTXT: && tag=tag' *) ) !log) in + let found = Some?(List.Tot.find (function (Entry k' text' tag') -> k=k' && text=text' (*CTXT: && tag=tag' *) ) !log) in (* plain, concrete implementation (ignoring the log) *) //verified diff --git a/examples/unit-tests/test_prims.fst b/examples/unit-tests/test_prims.fst index 1ecf5d4a823..192c12b89cb 100644 --- a/examples/unit-tests/test_prims.fst +++ b/examples/unit-tests/test_prims.fst @@ -304,14 +304,14 @@ type ExPost (a:Type) = result a -> Type0 type ExWP (a:Type) = ExPost a -> Tot ExPre type ex_return (a:Type) (x:a) (p:ExPost a) = p (V x) type ex_bind_wlp (a:Type) (b:Type) (wlp1:ExWP a) (wlp2:(a -> Tot (ExWP b))) (p:ExPost b) = - (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if is_V ra1 + (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if V? ra1 then wlp2 (V.v ra1) (fun rb2 -> rb2=!=rb) else ra1 =!= rb)) type ex_bind_wp (a:Type) (b:Type) (wp1:ExWP a) (wlp1:ExWP a) (wp2:(a -> Tot (ExWP b))) (wlp2:(a -> Tot (ExWP b))) (p:ExPost b) = ex_bind_wlp a b wlp1 wlp2 p - /\ wp1 (fun ra1 -> if is_V ra1 + /\ wp1 (fun ra1 -> if V? ra1 then wp2 (V.v ra1) (fun rb2 -> True) else True) type ex_if_then_else (a:Type) (p:Type) (wp_then:ExWP a) (wp_else:ExWP a) (post:ExPost a) = @@ -364,12 +364,12 @@ type all_bind_wp (heap:Type) (a:Type) (b:Type) (wp1:AllWP_h heap a) (wlp1:AllWP_h heap a) (wp2:(a -> Tot (AllWP_h heap b))) (wlp2:(a -> Tot (AllWP_h heap b))) (p:AllPost_h heap b) (h0:heap) = - (wp1 (fun ra h1 -> is_V ra ==> wp2 (V.v ra) p h1) h0) + (wp1 (fun ra h1 -> V? ra ==> wp2 (V.v ra) p h1) h0) type all_bind_wlp (heap:Type) (a:Type) (b:Type) (wlp1:AllWP_h heap a) (wlp2:(a -> Tot (AllWP_h heap b))) (p:AllPost_h heap b) (h0:heap) = (forall rb h. wlp1 (fun ra h1 -> - if is_V ra + if V? ra then wlp2 (V.v ra) (fun rb2 h2 -> rb=!=rb2 \/ h=!=h2) h1 else rb=!=ra \/ h=!=h1) h0 \/ p rb h) type all_if_then_else (heap:Type) (a:Type) (p:Type) diff --git a/examples/unit-tests/universes/Mac.fst b/examples/unit-tests/universes/Mac.fst index d7440104297..41149466c12 100644 --- a/examples/unit-tests/universes/Mac.fst +++ b/examples/unit-tests/universes/Mac.fst @@ -75,7 +75,7 @@ let mac k t = let verify k text tag = let verified = sha1verify k text tag in - let found = is_Some(List.Tot.find (function (Entry k' text' tag') -> eq k k' && eq text text' (*CTXT: && tag=tag' *) ) !log) in + let found = Some?(List.Tot.find (function (Entry k' text' tag') -> eq k k' && eq text text' (*CTXT: && tag=tag' *) ) !log) in (* plain, concrete implementation (ignoring the log) *) //verified diff --git a/examples/unit-tests/universes/NegativeTests.BST.fst b/examples/unit-tests/universes/NegativeTests.BST.fst index 4575a8669d6..21da4b1cf16 100644 --- a/examples/unit-tests/universes/NegativeTests.BST.fst +++ b/examples/unit-tests/universes/NegativeTests.BST.fst @@ -9,8 +9,8 @@ type tree: int -> Type = -> #r :int -> right:option (tree r){l <= n /\ n <= r - /\ (is_None right <==> n=r) - /\ (is_None left <==> n=l)} + /\ (None? right <==> n=r) + /\ (None? left <==> n=l)} -> tree r diff --git a/examples/unit-tests/universes/NegativeTests.Neg.fst b/examples/unit-tests/universes/NegativeTests.Neg.fst index e0ac3c10c5f..2fa13c87485 100644 --- a/examples/unit-tests/universes/NegativeTests.Neg.fst +++ b/examples/unit-tests/universes/NegativeTests.Neg.fst @@ -22,10 +22,10 @@ val test_postcondition_label: x:int -> Pure int (requires True) (ensures (fun y let test_postcondition_label x = x //should fail val bad_projector: option 'a -> 'a -let bad_projector x = Some.v x (* should fail *) +let bad_projector x = Some?.v x (* should fail *) assume type t_pred : (result int -> Type) -> Type -assume TEST: t_pred (fun ri -> b2t (V.v ri = 0))//should fail: not (is_V ri) +assume TEST: t_pred (fun ri -> b2t (V?.v ri = 0))//should fail: not (V? ri) assume val f1: (x:int -> Tot unit) -> Tot unit assume val g1: nat -> Tot unit diff --git a/examples/unit-tests/universes/Unit1.Basic.fst b/examples/unit-tests/universes/Unit1.Basic.fst index d133ca94ce0..43f039e517d 100644 --- a/examples/unit-tests/universes/Unit1.Basic.fst +++ b/examples/unit-tests/universes/Unit1.Basic.fst @@ -44,7 +44,7 @@ let hd_int_impure_default_case l = match l with | hd::_ -> hd | _ -> failwith "Empty list" -val hd_int_pure : x:list int{is_Cons x} -> Tot int +val hd_int_pure : x:list int{Cons? x} -> Tot int let hd_int_pure l = match l with | hd::_ -> hd @@ -80,7 +80,7 @@ let tabs_id (a:Type) (x:'a) = x val id_pure_annot_eq : #a:eqtype -> x:a -> Pure a True (fun y -> b2t (y=x)) let id_pure_annot_eq #a x = x -val id_all_annot_eq: #a:eqtype -> x:a -> All a (fun h -> True) (fun h0 y h1 -> is_V y /\ h0==h1 /\ x=(V.v y)) +val id_all_annot_eq: #a:eqtype -> x:a -> All a (fun h -> True) (fun h0 y h1 -> V? y /\ h0==h1 /\ x=(V?.v y)) let id_all_annot_eq #a x = x val hd: list 'a -> 'a @@ -88,11 +88,11 @@ let hd = function | x::_ -> x | _ -> failwith "empty list" -val hd_pure: l:list 'a{is_Cons l} -> Tot 'a +val hd_pure: l:list 'a{Cons? l} -> Tot 'a let hd_pure l = match l with | x::_ -> x -val hd_pure_alt: x:list 'a{is_Cons x} -> Tot 'a +val hd_pure_alt: x:list 'a{Cons? x} -> Tot 'a let hd_pure_alt = function | hd::_ -> hd @@ -100,7 +100,7 @@ val dup_pure: x:'a -> Tot ('a * 'a) let dup_pure x = (x,x) val dup_pure_eq: #a:eqtype -> x:a -> Pure (a * a) True - (fun y -> b2t (Mktuple2._1 y=Mktuple2._2 y)) + (fun y -> b2t (Mktuple2?._1 y=Mktuple2?._2 y)) let dup_pure_eq #a x = (x,x) (* the programs below are equivalent---see the refinement of the result in tc.fs/Exp_app case. *) @@ -154,7 +154,7 @@ noeq type seq (a:Type0) = -> end_i:nat{end_i >= start_i} -> seq a type message = seq char -let slength s = Seq.end_i s - Seq.start_i s +let slength s = Seq?.end_i s - Seq?.start_i s assume val impure: m:message -> ST message (requires (fun h -> True)) (ensures (fun h0 n h1 -> slength n = slength m)) @@ -183,8 +183,8 @@ let do_ok l = match l with | N -> N | C(n, l') -> if n = 0 then l else C(0, l') -val short_circuit1: x:option int{is_Some x /\ Some.v x = 0} -> nat -let short_circuit1 x = Some.v x +val short_circuit1: x:option int{Some? x /\ Some?.v x = 0} -> nat +let short_circuit1 x = Some?.v x (* TESTING skolem variables for lambdas *) @@ -211,7 +211,7 @@ let rec find f = function val test_skolem_let: x:int -> Tot (b:bool{b ==> x=0}) let test_skolem_let x = let found = find (fun y -> x=0) [x] in - is_Some found + Some? found (* TESTING implicit binding of conditionally total function arguments *) assume val id_wrap1: x:int -> Pure int (requires True) (ensures (fun y -> x=y)) diff --git a/examples/unit-tests/universes/Unit1.RefinementInference.fst b/examples/unit-tests/universes/Unit1.RefinementInference.fst index 307fe014e38..9a5560a23a7 100644 --- a/examples/unit-tests/universes/Unit1.RefinementInference.fst +++ b/examples/unit-tests/universes/Unit1.RefinementInference.fst @@ -1,11 +1,11 @@ module Unit1.RefinementInference assume type erased : Type -> Type assume val reveal: erased 'a -> GTot 'a -assume val consHd : #a:Type -> l:list a{is_Cons l} -> Tot a +assume val consHd : #a:Type -> l:list a{Cons? l} -> Tot a assume val elift1_p : #a:Type -> #b:Type -> #p:(a -> GTot Type) -> $f:(x:a{p x} -> Tot b) -> r:erased a{p (reveal r) } -> Tot (erased b) -val ghostConsHd : a:Type -> l:erased (list a){is_Cons (reveal l)} -> Tot (erased a) +val ghostConsHd : a:Type -> l:erased (list a){Cons? (reveal l)} -> Tot (erased a) let ghostConsHd (a:Type) l = elift1_p consHd l diff --git a/examples/unit-tests/universes/listTot.fst b/examples/unit-tests/universes/listTot.fst index de8766a74e5..ed9915fef77 100644 --- a/examples/unit-tests/universes/listTot.fst +++ b/examples/unit-tests/universes/listTot.fst @@ -22,11 +22,11 @@ let isEmpty l = match l with | [] -> true | _ -> false -val hd: l:list 'a{is_Cons l} -> Tot 'a +val hd: l:list 'a{Cons? l} -> Tot 'a let hd = function | hd::_ -> hd -val tl: l:list 'a {is_Cons l} -> Tot (list 'a) +val tl: l:list 'a {Cons? l} -> Tot (list 'a) let tl = function | _::tl -> tl diff --git a/examples/unit-tests/universes/test_prims.fst b/examples/unit-tests/universes/test_prims.fst index 1ecf5d4a823..192c12b89cb 100644 --- a/examples/unit-tests/universes/test_prims.fst +++ b/examples/unit-tests/universes/test_prims.fst @@ -304,14 +304,14 @@ type ExPost (a:Type) = result a -> Type0 type ExWP (a:Type) = ExPost a -> Tot ExPre type ex_return (a:Type) (x:a) (p:ExPost a) = p (V x) type ex_bind_wlp (a:Type) (b:Type) (wlp1:ExWP a) (wlp2:(a -> Tot (ExWP b))) (p:ExPost b) = - (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if is_V ra1 + (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if V? ra1 then wlp2 (V.v ra1) (fun rb2 -> rb2=!=rb) else ra1 =!= rb)) type ex_bind_wp (a:Type) (b:Type) (wp1:ExWP a) (wlp1:ExWP a) (wp2:(a -> Tot (ExWP b))) (wlp2:(a -> Tot (ExWP b))) (p:ExPost b) = ex_bind_wlp a b wlp1 wlp2 p - /\ wp1 (fun ra1 -> if is_V ra1 + /\ wp1 (fun ra1 -> if V? ra1 then wp2 (V.v ra1) (fun rb2 -> True) else True) type ex_if_then_else (a:Type) (p:Type) (wp_then:ExWP a) (wp_else:ExWP a) (post:ExPost a) = @@ -364,12 +364,12 @@ type all_bind_wp (heap:Type) (a:Type) (b:Type) (wp1:AllWP_h heap a) (wlp1:AllWP_h heap a) (wp2:(a -> Tot (AllWP_h heap b))) (wlp2:(a -> Tot (AllWP_h heap b))) (p:AllPost_h heap b) (h0:heap) = - (wp1 (fun ra h1 -> is_V ra ==> wp2 (V.v ra) p h1) h0) + (wp1 (fun ra h1 -> V? ra ==> wp2 (V.v ra) p h1) h0) type all_bind_wlp (heap:Type) (a:Type) (b:Type) (wlp1:AllWP_h heap a) (wlp2:(a -> Tot (AllWP_h heap b))) (p:AllPost_h heap b) (h0:heap) = (forall rb h. wlp1 (fun ra h1 -> - if is_V ra + if V? ra then wlp2 (V.v ra) (fun rb2 h2 -> rb=!=rb2 \/ h=!=h2) h1 else rb=!=ra \/ h=!=h1) h0 \/ p rb h) type all_if_then_else (heap:Type) (a:Type) (p:Type) diff --git a/examples/wysteria/ast.fst b/examples/wysteria/ast.fst index 1d074b84478..30d1f77e8df 100644 --- a/examples/wysteria/ast.fst +++ b/examples/wysteria/ast.fst @@ -201,24 +201,24 @@ type term = type level = | Source | Target val src: level -> Tot bool -let src l = is_Source l +let src l = Source? l (* TODO: FIXME: workaround for projectors *) val m_of_mode: mode -> Tot as_mode let m_of_mode (Mode m _) = m type mode_inv (m:mode) (l:level) = - (is_Target l /\ m_of_mode m = Par) ==> (size (Mode.ps m) = 1) + (Target? l /\ m_of_mode m = Par) ==> (size (Mode.ps m) = 1) val is_sec_frame: f':frame' -> Tot bool let is_sec_frame f' = - not (is_F_aspar_ps f' || is_F_aspar_e f' || is_F_aspar_ret f') + not (F_aspar_ps? f' || F_aspar_e? f' || F_aspar_ret? f') val is_par_frame: f':frame' -> Tot bool -let is_par_frame f' = not (is_F_mksh f' || is_F_combsh f') +let is_par_frame f' = not (F_mksh? f' || F_combsh? f') (* TODO: FIXME: workaround for projectors *) -val ps_of_aspar_ret_frame: f':frame'{is_F_aspar_ret f'} -> Tot prins +val ps_of_aspar_ret_frame: f':frame'{F_aspar_ret? f'} -> Tot prins let ps_of_aspar_ret_frame (F_aspar_ret ps) = ps val stack_source_inv: stack -> mode -> GTot bool @@ -227,12 +227,12 @@ let rec stack_source_inv s (Mode as_m ps) = match s with | (Frame m' _ f' tr)::tl -> let Mode as_m' ps' = m' in (not (as_m = Par) || as_m' = Par) && - (not (as_m = Par) || not (is_F_assec_ret f')) && - (not (as_m = Sec) || (not (as_m' = Par) || is_F_assec_ret f')) && - (not (as_m' = Sec) || (is_sec_frame f' && is_Cons tl)) && + (not (as_m = Par) || not (F_assec_ret? f')) && + (not (as_m = Sec) || (not (as_m' = Par) || F_assec_ret? f')) && + (not (as_m' = Sec) || (is_sec_frame f' && Cons? tl)) && (not (as_m' = Sec) || (vals_trace tr)) && - (not (is_F_aspar_ret f') || (ps = ps_of_aspar_ret_frame f')) && - (ps = ps' || (subset ps ps' && is_F_aspar_ret f')) && + (not (F_aspar_ret? f') || (ps = ps_of_aspar_ret_frame f')) && + (ps = ps' || (subset ps ps' && F_aspar_ret? f')) && (not (as_m = Par) || is_par_frame f') && stack_source_inv tl m' @@ -248,23 +248,23 @@ let rec stack_target_inv s m = match s with val stack_inv: stack -> mode -> level -> GTot bool let rec stack_inv s m l = - if is_Source l then stack_source_inv s m else stack_target_inv s m + if Source? l then stack_source_inv s m else stack_target_inv s m val is_sec_redex: redex -> Tot bool -let is_sec_redex r = not (is_R_aspar r) //|| is_R_box r) +let is_sec_redex r = not (R_aspar? r) //|| R_box? r) val is_par_redex: redex -> Tot bool -let is_par_redex r = not (is_R_mksh r || is_R_combsh r) //|| is_R_box r) +let is_par_redex r = not (R_mksh? r || R_combsh? r) //|| R_box? r) (* TODO: FIXME: workaround for projectors *) -val r_of_t_red: t:term{is_T_red t} -> Tot redex +val r_of_t_red: t:term{T_red? t} -> Tot redex let r_of_t_red (T_red r) = r val term_inv: term -> mode -> level -> Tot bool let term_inv t m l = - (not (is_Source l) || not (t = T_sec_wait)) && - (not (is_T_red t && m_of_mode m = Sec) || is_sec_redex (r_of_t_red t)) && - (not (is_T_red t && m_of_mode m = Par) || is_par_redex (r_of_t_red t)) + (not (Source? l) || not (t = T_sec_wait)) && + (not (T_red? t && m_of_mode m = Sec) || is_sec_redex (r_of_t_red t)) && + (not (T_red? t && m_of_mode m = Par) || is_par_redex (r_of_t_red t)) val trace_inv: erased trace -> mode -> GTot bool let trace_inv tr m = not (m_of_mode m = Sec) || (vals_trace tr) @@ -274,26 +274,26 @@ type config = -> en:env -> t:term{term_inv t m l} -> tr:erased trace{trace_inv tr m} -> config -type sconfig = c:config{is_Source (Conf.l c)} -type tconfig = c:config{is_Target (Conf.l c)} +type sconfig = c:config{Source? (Conf.l c)} +type tconfig = c:config{Target? (Conf.l c)} (* TODO: FIXME: workaround for projectors *) val f_of_frame: frame -> Tot frame' let f_of_frame (Frame _ _ f _) = f (* TODO: FIXME: workaround for projectors *) -val hd_of_list: l:list 'a{is_Cons l} -> Tot 'a +val hd_of_list: l:list 'a{Cons? l} -> Tot 'a let hd_of_list (Cons hd _) = hd val is_sframe: c:config -> f:(frame' -> Tot bool) -> Tot bool -let is_sframe (Conf _ _ s _ _ _) f = is_Cons s && f (f_of_frame (hd_of_list s)) +let is_sframe (Conf _ _ s _ _ _) f = Cons? s && f (f_of_frame (hd_of_list s)) (* TODO: FIXME: workaround for projectors *) val t_of_conf: config -> Tot term let t_of_conf (Conf _ _ _ _ t _) = t val is_value: c:config -> Tot bool -let is_value c = is_T_val (t_of_conf c) +let is_value c = T_val? (t_of_conf c) val is_value_ps: c:config -> Tot bool let is_value_ps c = match c with @@ -321,14 +321,14 @@ val m_of_conf: config-> Tot mode let m_of_conf (Conf _ m _ _ _ _) = m val is_par: config -> Tot bool -let is_par c = is_Par (m_of_mode (m_of_conf c)) +let is_par c = Par? (m_of_mode (m_of_conf c)) val is_sec: config -> Tot bool -let is_sec c = is_Sec (m_of_mode (m_of_conf c)) +let is_sec c = Sec? (m_of_mode (m_of_conf c)) (* TODO: FIXME: the discriminators should take extra args for type indices *) val is_clos: #meta:v_meta -> value meta -> Tot bool -let is_clos #meta v = match v with//is_V_clos v || is_V_fix_clos v || is_V_emp_clos v +let is_clos #meta v = match v with//V_clos? v || V_fix_clos? v || V_emp_clos? v | V_clos _ _ _ | V_emp_clos _ _ | V_fix_clos _ _ _ _ -> true @@ -342,10 +342,10 @@ let get_en_b #meta v = match v with | V_emp_clos x e -> empty_env, x, e val is_terminal: config -> Tot bool -let is_terminal (Conf _ (Mode as_m _) s _ t _) = as_m = Par && s = [] && is_T_val t +let is_terminal (Conf _ (Mode as_m _) s _ t _) = as_m = Par && s = [] && T_val? t val is_sterminal: config -> Tot bool -let is_sterminal (Conf _ _ s _ t _) = s = [] && is_T_val t +let is_sterminal (Conf _ _ s _ t _) = s = [] && T_val? t //-----// diff --git a/examples/wysteria/ckt.fst b/examples/wysteria/ckt.fst index 42ad7780fc4..09daac87db3 100644 --- a/examples/wysteria/ckt.fst +++ b/examples/wysteria/ckt.fst @@ -63,16 +63,16 @@ let is_nat t = match t with | T_cons s _ -> s = "Prims.int" | _ -> false -let hd_of_cons (l:list 'a{is_Cons l}) = match l with +let hd_of_cons (l:list 'a{Cons? l}) = match l with | Cons x y -> x -let tl_of_cons (l:list 'a{is_Cons l}) = match l with +let tl_of_cons (l:list 'a{Cons? l}) = match l with | Cons x y -> y val is_int_list: typ -> Tot bool let is_int_list t = match t with | T_cons l _ -> - l = "Prims.list" && is_Cons (T_cons.args t) && is_nat (hd_of_cons (T_cons.args t)) + l = "Prims.list" && Cons? (T_cons.args t) && is_nat (hd_of_cons (T_cons.args t)) | _ -> false type inputmap = ordmap prin varset p_cmp @@ -94,7 +94,7 @@ let supported_input_type t = match t with | _ -> false val is_share_var: varname -> Tot bool -let is_share_var (Var _ t) = is_T_sh t +let is_share_var (Var _ t) = T_sh? t val assign_prin: prins -> v:varname{not (is_share_var v)} -> env -> prin let assign_prin ps v en = @@ -223,7 +223,7 @@ let rec alloc_shinput_wires rbegin rend fvs cs cen = let Some v = choose fvs in let fvs' = remove v fvs in let Var s t = v in - if is_T_sh t then + if T_sh? t then let r = alloc_wires natsize in let rbegin = if rbegin = 0 then fst r else rbegin in alloc_shinput_wires rbegin (snd r) fvs' cs (fun s' -> if s' = s then Some r else cen s') @@ -265,7 +265,7 @@ let rec get_cth_mem (c:nat) (r:wrange) = let f x = failwith "This is a never called function" -let rec mem_exp_to_exp (x:exp{is_E_var x}) (l:exp{is_E_var l}) (c:nat) = +let rec mem_exp_to_exp (x:exp{E_var? x}) (l:exp{E_var? l}) (c:nat) = if c = listsize then E_const (C_bool false) else let cth = E_ffi 2 "FFI.nth" f [E_const (C_opaque c (T_cons "Prims.int" [])); l] f in @@ -276,7 +276,7 @@ let rec mem_exp_to_exp (x:exp{is_E_var x}) (l:exp{is_E_var l}) (c:nat) = E_cond cond thenb elseb -let rec intersect_exp_to_exp (l1:exp{is_E_var l1}) (l2:exp{is_E_var l2}) (c:nat) = +let rec intersect_exp_to_exp (l1:exp{E_var? l1}) (l2:exp{E_var? l2}) (c:nat) = if c = listsize then E_ffi 0 "FFI.mk_nil" f [] f else let nth_v = Var "__tmp_n__" (T_cons "Prims.int" []) in @@ -303,7 +303,7 @@ let rec exp_to_ckt cen e = match e with | E_const c -> const_to_ckt c | E_var (Var s t) -> let r_opt = cen s in - if is_None r_opt then failwith "Variable not found in cenv" + if None? r_opt then failwith "Variable not found in cenv" else [], Some.v r_opt, t | E_let x e1 e2 -> @@ -342,7 +342,7 @@ let rec exp_to_ckt cen e = match e with let a1 = List.hd args in let a2 = List.hd (List.tl args) in let cs2, r2, _ = exp_to_ckt cen a2 in - if is_E_const a1 && is_C_opaque (E_const.c a1) then + if E_const? a1 && C_opaque? (E_const.c a1) then let c = Ffibridge.nat_of_c_opaque (E_const.c a1) in //FStar.IO.print_string "get_cth_mem with c: "; FStar.IO.print_string (string_of_int c); FStar.IO.print_string ", with range: "; FStar.IO.print_string (range_to_string r2); FStar.IO.print_string "\n"; cs2, get_cth_mem c r2, T_cons "Prims.int" [] @@ -351,7 +351,7 @@ let rec exp_to_ckt cen e = match e with else if fname = "FFI.list_mem" then let a1 = List.hd args in let a2 = List.hd (List.tl args) in - if is_E_var a1 && is_E_var a2 then + if E_var? a1 && E_var? a2 then let e' = mem_exp_to_exp a1 a2 0 in //FStar.IO.print_string (Print.exp_to_string e'); exp_to_ckt cen e' @@ -360,7 +360,7 @@ let rec exp_to_ckt cen e = match e with else if fname = "FFI.list_intersect" then let a1 = List.hd args in let a2 = List.hd (List.tl args) in - if is_E_var a1 && is_E_var a2 then + if E_var? a1 && E_var? a2 then let e' = intersect_exp_to_exp a1 a2 0 in exp_to_ckt cen e' else failwith "FFI.list_intersect is supported only for variable expressions" @@ -671,13 +671,13 @@ let dump_gmw prs bckt fd = let ps s = write_string fd s in let psi i = write_string fd (string_of_int i) in - let inps = filter (fun bcelt -> is_INPUT bcelt || is_SHINPUT bcelt) bckt in + let inps = filter (fun bcelt -> INPUT? bcelt || SHINPUT? bcelt) bckt in //print_string "done1"; - let outs = filter (fun bcelt -> is_OUTPUT bcelt || is_SHOUTPUT bcelt) bckt in + let outs = filter (fun bcelt -> OUTPUT? bcelt || SHOUTPUT? bcelt) bckt in //print_string "done2"; - let ands = filter (fun bcelt -> is_AND bcelt) bckt in + let ands = filter (fun bcelt -> AND? bcelt) bckt in //print_string "done3"; - let xors = filter (fun bcelt -> is_XOR bcelt) bckt in + let xors = filter (fun bcelt -> XOR? bcelt) bckt in let aux = calc_auxinf bckt in //print_string "done4"; @@ -792,11 +792,11 @@ let rec dump_inps vars en fd = let Some v = choose vars in let vars' = remove v vars in let Var _ t = v in - if is_T_sh t then dump_inps vars' en fd + if T_sh? t then dump_inps vars' en fd else if supported_input_type t then let dv_opt = en v in - if is_None dv_opt then failwith "Input is not mapped in the env" + if None? dv_opt then failwith "Input is not mapped in the env" else let Some (D_v _ v) = dv_opt in dump_val v t fd; @@ -815,10 +815,10 @@ let rec dump_shinps vars en fd = let Some v = choose vars in let vars' = remove v vars in let Var _ t = v in - if not (is_T_sh t) then dump_shinps vars' en fd + if not (T_sh? t) then dump_shinps vars' en fd else let dv_opt = en v in - if is_None dv_opt then failwith "Sh input not mapped in the env" + if None? dv_opt then failwith "Sh input not mapped in the env" else let Some (D_v _ v) = dv_opt in if is_v_sh v then diff --git a/examples/wysteria/crypto.fst b/examples/wysteria/crypto.fst index 631fc528d37..42c9edbc5a4 100644 --- a/examples/wysteria/crypto.fst +++ b/examples/wysteria/crypto.fst @@ -15,7 +15,7 @@ open Platform.Bytes open SHA1 opaque type client_prop (p:prin) (r:redex) = - is_R_assec r /\ is_clos (R_assec.v r) /\ mem p (R_assec.ps r) /\ + R_assec? r /\ is_clos (R_assec.v r) /\ mem p (R_assec.ps r) /\ (exists c. Conf.t c = T_red r /\ Conf.l c = Target /\ Conf.m c = Mode Par (singleton p)) opaque type server_prop_witness (#a:Type) (#b:Type) (x:a) (y:b) = True @@ -26,7 +26,7 @@ opaque type server_prop (p:prin) (r:redex) (ps:prins) (x:varname) (e:exp) (dv:dv tpre_assec #ps (pi, OrdMap.empty #prins #tconfig_sec #ps_cmp) ps x e /\ T_red.r (Conf.t (Some.v (select p pi))) = r /\ pstep_star #ps (pi, OrdMap.empty #prins #tconfig_sec #ps_cmp) pi_final /\ - is_T_val (Conf.t (Some.v (select p (fst pi_final)))) /\ + T_val? (Conf.t (Some.v (select p (fst pi_final)))) /\ D_v (T_val.meta (Conf.t (Some.v (select p (fst pi_final))))) (T_val.v (Conf.t (Some.v (select p (fst pi_final))))) = dv) @@ -92,7 +92,7 @@ let verify_client_msg k m t = if (not b) then None else let msg = unmarshal #(prin * redex) m in - let found = is_Some (List.find (fun (CEntry k' msg' mac') -> k = k' && msg' = msg && mac' = t) !client_log) in + let found = Some? (List.find (fun (CEntry k' msg' mac') -> k = k' && msg' = msg && mac' = t) !client_log) in if found then Some msg else None @@ -115,7 +115,7 @@ let verify_server_msg k m t = if (not b) then None else let msg = unmarshal #server_ret_type m in - let found = is_Some (List.find (fun (SEntry k' msg' mac') -> k = k' && msg' = msg && mac' = t) !server_log) in + let found = Some? (List.find (fun (SEntry k' msg' mac') -> k = k' && msg' = msg && mac' = t) !server_log) in if found then Some msg else None diff --git a/examples/wysteria/examples/attic/inline.fst b/examples/wysteria/examples/attic/inline.fst index c4e91f41417..93ee380853f 100644 --- a/examples/wysteria/examples/attic/inline.fst +++ b/examples/wysteria/examples/attic/inline.fst @@ -124,11 +124,11 @@ let rec unfold m en e f = | E_const _ -> en, e | E_var x -> let dv_opt = en x in - if is_None dv_opt then (en, E_var x) + if None? dv_opt then (en, E_var x) else let dv = Some.v dv_opt in let e_opt = value_to_exp en dv in - if is_None e_opt then en, E_var x + if None? e_opt then en, E_var x else Some.v e_opt | E_let x e1 e2 -> en, E_let x (snd (unfold m en e1 f)) (snd (unfold m en e2 f)) | E_abs x e -> en, E_abs x (snd (unfold m en e f)) diff --git a/examples/wysteria/examples/attic/mill6.fst b/examples/wysteria/examples/attic/mill6.fst index dea0351de46..9cd4e2b777f 100644 --- a/examples/wysteria/examples/attic/mill6.fst +++ b/examples/wysteria/examples/attic/mill6.fst @@ -57,7 +57,7 @@ let mill8_sec ps w _ = -> (p:prin{w_contains p w}) -> (y:int{w_select p w = y}) -> Wys (option (p:prin{w_contains p w})) (pre (Mode Sec ps)) post = fun x p y -> - if is_None x then mk_some p + if None? x then mk_some p else let p' = Some.v x in let y' = projwire_s p' w in @@ -69,7 +69,7 @@ let mill8_sec ps w _ = in let p = as_sec ps g in - if is_None p then mk_none () else mk_some (Some.v p) + if None? p then mk_none () else mk_some (Some.v p) val mill8: unit -> Wys bool (pre (Mode Par abc)) post let mill8 _ = diff --git a/examples/wysteria/examples/attic/psi.fst b/examples/wysteria/examples/attic/psi.fst index d022d2cb52b..988b42f604f 100644 --- a/examples/wysteria/examples/attic/psi.fst +++ b/examples/wysteria/examples/attic/psi.fst @@ -131,14 +131,14 @@ let psi ps w = val regmem: int -> list int -> Tot bool let rec regmem x l = - if is_Nil l then false + if Nil? l then false else if hd_of_cons l = x then true else regmem x (tl_of_cons l) val intersect: l1:list int -> l2:list int -> Tot (list int) let rec intersect l1 l2 = - if is_Nil l1 then mk_nil () + if Nil? l1 then mk_nil () else if regmem (hd_of_cons l1) l2 then mk_cons (hd_of_cons l1) (intersect (tl_of_cons l1) l2) else intersect (tl_of_cons l1) l2 diff --git a/examples/wysteria/examples/attic/rttt.fst b/examples/wysteria/examples/attic/rttt.fst index eeab895f304..cd4b652b12e 100644 --- a/examples/wysteria/examples/attic/rttt.fst +++ b/examples/wysteria/examples/attic/rttt.fst @@ -19,11 +19,11 @@ let tstep_assec_lemma ps' pi ps x e pi' = admit () val sec_enter_is_parametric: ps:prins -> pi:protocol ps -> pi':protocol ps - -> h:pstep #ps pi pi'{is_P_sec_enter h /\ P_sec_enter.ps h = ps} + -> h:pstep #ps pi pi'{P_sec_enter? h /\ P_sec_enter.ps h = ps} -> p:prin{contains p (fst pi)} -> c:tconfig_par{same_c (Some.v (select p (fst pi))) c} -> Tot (h':(pstep #ps (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi) (update #prin #tconfig_par #p_cmp p (step_p_to_wait c p) (fst pi'), snd pi')) - {is_P_sec_enter h'}) + {P_sec_enter? h'}) let sec_enter_is_parametric ps pi pi' h p c = let x = P_sec_enter.x h in let e = P_sec_enter.e h in @@ -52,11 +52,11 @@ let sec_enter_is_parametric ps pi pi' h p c = val sec_step_is_parametric: ps:prins -> pi:protocol ps -> pi':protocol ps - -> h:pstep #ps pi pi'{is_P_sec h /\ P_sec.ps h = ps} + -> h:pstep #ps pi pi'{P_sec? h /\ P_sec.ps h = ps} -> p:prin{contains p (fst pi)} -> c:tconfig_par{same_c (Some.v (select p (fst pi))) c} -> Tot (h':(pstep #ps (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi) (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi')) - {is_P_sec h'}) + {P_sec? h'}) let sec_step_is_parametric ps pi pi' h p c = P_sec #ps #(P_sec.c' h) (update p c (fst pi), snd pi) ps (P_sec.h h) (update p c (fst pi), snd pi') @@ -97,7 +97,7 @@ val sec_comp_is_parametric: -> pi_final:protocol ps{contains ps (snd pi_final) /\ Conf.m (Some.v (select ps (snd pi_final))) = Mode Sec ps /\ is_sterminal (Some.v (select ps (snd pi_final)))} - -> h1:pstep #ps (pi, OrdMap.empty #prins #tconfig_sec #ps_cmp) pi_enter{is_P_sec_enter h1 /\ P_sec_enter.ps h1 = ps} + -> h1:pstep #ps (pi, OrdMap.empty #prins #tconfig_sec #ps_cmp) pi_enter{P_sec_enter? h1 /\ P_sec_enter.ps h1 = ps} -> h2:pstep_star #ps pi_enter pi_final{all_sec_steps ps pi_enter pi_final h2 ps} -> p:prin{contains p pi} -> c:tconfig_par{same_c (Some.v (select p pi)) c} -> dv:dvalue{dv = slice_v p (D_v.v (c_value (Some.v (select ps (snd pi_final)))))} @@ -157,7 +157,7 @@ index ad86356..90e3641 100644 + (decreases h) +let rec all_sec_steps ps pi pi' h ps' = match h with + | PS_refl _ -> true -+ | PS_tran #ps #pi #pi' #pi'' h1 h2 -> is_P_sec h1 && P_sec.ps h1 = ps' && all_sec_steps ps pi' pi'' h2 ps' ++ | PS_tran #ps #pi #pi' #pi'' h1 h2 -> P_sec? h1 && P_sec.ps h1 = ps' && all_sec_steps ps pi' pi'' h2 ps' + opaque val sec_sstep_star_to_pstep_star: c:config{is_sec_comp c} -> c':config{is_sec_comp c'} -> h:sstep_star c c' diff --git a/examples/wysteria/examples/cards.fst b/examples/wysteria/examples/cards.fst index 485ba161282..8b8a6af9e45 100644 --- a/examples/wysteria/examples/cards.fst +++ b/examples/wysteria/examples/cards.fst @@ -36,7 +36,7 @@ assume val rand: n:pos -> Tot (r:nat{r < n}) val get_deck: deck:list nat -> remaining:list nat -> Tot (list nat) (decreases (length remaining)) let rec get_deck deck remaining = - if is_Nil remaining then deck + if Nil? remaining then deck else let r = rand (length remaining) in // a random index in the remaining list let e = nth remaining r in // the rth element in the list @@ -57,7 +57,7 @@ let to_s2 p1 p2 = union (singleton p1) (singleton p2) val deck_to_int_list: list nat -> Tot (list int) let rec deck_to_int_list l = - if is_Nil l then mk_nil () else mk_cons (hd_of_cons l) (deck_to_int_list (tl_of_cons l)) + if Nil? l then mk_nil () else mk_cons (hd_of_cons l) (deck_to_int_list (tl_of_cons l)) val shuffle_deck: ps:prins -> unit -> Wys (list nat * nat) (pre (Mode Par ps)) post let shuffle_deck ps _ = diff --git a/examples/wysteria/examples/ffi.fst b/examples/wysteria/examples/ffi.fst index a08dd35aebb..265c63039e0 100644 --- a/examples/wysteria/examples/ffi.fst +++ b/examples/wysteria/examples/ffi.fst @@ -139,7 +139,7 @@ let slice_option f p = function | None -> None | Some x -> Some (f p x) -val compose_options: ('a -> 'a -> Tot 'a) -> x:option 'a -> y:option 'a{is_Some x <==> is_Some y} -> Tot (option 'a) +val compose_options: ('a -> 'a -> Tot 'a) -> x:option 'a -> y:option 'a{Some? x <==> Some? y} -> Tot (option 'a) let compose_options f x y = match x, y with | None, None -> None | Some x', Some y' -> Some (f x' y') @@ -170,11 +170,11 @@ let rec compose_lists f l1 l2 = match l1, l2 with val slice_list_sps: (prins -> 'a -> Tot 'a) -> prins -> list 'a -> Tot (list 'a) let slice_list_sps f ps l = FStar.List.Tot.map (f ps) l -val hd_of_cons: l:list 'a{is_Cons l} -> Tot 'a +val hd_of_cons: l:list 'a{Cons? l} -> Tot 'a let hd_of_cons = function | hd::_ -> hd -val tl_of_cons: l:list 'a{is_Cons l} -> Tot (list 'a) +val tl_of_cons: l:list 'a{Cons? l} -> Tot (list 'a) let tl_of_cons = function | _::tl -> tl diff --git a/examples/wysteria/examples/fstar_main/psipaper.fst b/examples/wysteria/examples/fstar_main/psipaper.fst index 81abd8a50a3..5e0863e66b6 100644 --- a/examples/wysteria/examples/fstar_main/psipaper.fst +++ b/examples/wysteria/examples/fstar_main/psipaper.fst @@ -55,7 +55,7 @@ val row: -> matrix:list bool{length matrix = (length la * lenb) - bindex} -> Tot (list int) (decreases matrix) let rec row la lenb bindex matrix = - if is_Nil matrix then mk_nil () + if Nil? matrix then mk_nil () else let b = hd_of_cons matrix in let tl = tl_of_cons matrix in @@ -72,18 +72,18 @@ let rec row la lenb bindex matrix = (* col function, bob will use it to compute intersection *) val col: - lb:list int{is_Cons lb} -> lbc:list int{is_Cons lbc} + lb:list int{Cons? lb} -> lbc:list int{Cons? lbc} -> matrix:list bool -> Tot (list int) (decreases matrix) let rec col lb lbc matrix = - if is_Nil matrix then mk_nil () + if Nil? matrix then mk_nil () else let b = hd_of_cons matrix in let tl = tl_of_cons matrix in let lbc_hd = hd_of_cons lbc in let lbc_tl = tl_of_cons lbc in let rest = - if is_Nil lbc_tl then + if Nil? lbc_tl then col lb lb tl else col lb lbc_tl tl in @@ -119,21 +119,21 @@ val row_opt: -> s:list nat -> Dv (list int) (decreases matrix) let rec row_opt la lenb bindex matrix s = - if is_Nil matrix then mk_nil () + if Nil? matrix then mk_nil () else if not (lmem bindex s) then (* the bindex has not been skipped *) let b = hd_of_cons matrix in let tl = tl_of_cons matrix in if b then (* matched *) - let _ = admitP (b2t (is_Cons la)) in + let _ = admitP (b2t (Cons? la)) in let rest = row_opt (tl_of_cons la) lenb 0 tl (mk_cons bindex s) in mk_cons (hd_of_cons la) rest else (* no match *) let bindex' = bindex + 1 in if bindex' = lenb then - let _ = admitP (b2t (is_Cons la)) in + let _ = admitP (b2t (Cons? la)) in row_opt (tl_of_cons la) lenb 0 tl s else row_opt la lenb bindex' tl s @@ -141,7 +141,7 @@ let rec row_opt la lenb bindex matrix s = (* bindex was skipped *) let bindex' = bindex + 1 in if bindex' = lenb then - let _ = admitP (b2t (is_Cons la)) in + let _ = admitP (b2t (Cons? la)) in row_opt (tl_of_cons la) lenb 0 matrix s else row_opt la lenb bindex' matrix s @@ -150,13 +150,13 @@ val col_opt: lb:list int -> lbc:list int -> matrix:list bool -> matched:list int -> Dv (list int) let rec col_opt lb lbc matrix matched = - if is_Nil matrix then mk_nil () + if Nil? matrix then mk_nil () else - let _ = admitP (b2t (is_Cons lbc)) in + let _ = admitP (b2t (Cons? lbc)) in (* this element is being skipped in the matrix *) if lmem (hd_of_cons lbc) matched then let lbc_tl = tl_of_cons lbc in - if is_Nil lbc_tl then + if Nil? lbc_tl then col_opt lb lb matrix matched else col_opt lb lbc_tl matrix matched @@ -169,7 +169,7 @@ let rec col_opt lb lbc matrix matched = mk_cons (hd_of_cons lbc) rest else let lbc_tl = tl_of_cons lbc in - if is_Nil lbc_tl then + if Nil? lbc_tl then col_opt lb lb tl matched else col_opt lb lbc_tl tl matched diff --git a/examples/wysteria/examples/fstar_main/psiproof.fst b/examples/wysteria/examples/fstar_main/psiproof.fst index 76eed0b32cc..9b6825e529c 100644 --- a/examples/wysteria/examples/fstar_main/psiproof.fst +++ b/examples/wysteria/examples/fstar_main/psiproof.fst @@ -17,11 +17,11 @@ type post (#a:Type) = fun (m:mode) (x:a) (t:trace) -> True type pre_with (m:mode) (t:Type) = fun m0 -> m0 = m /\ t (* this is saying that the trace only consists of TMsg (no scopes) and all boolean values *) -type btrace_t (t:trace) = forall x. List.mem x t ==> (is_TMsg x /\ TMsg.a x == bool) +type btrace_t (t:trace) = forall x. List.mem x t ==> (TMsg? x /\ TMsg.a x == bool) type btrace = t:trace{btrace_t t} -val tl_btrace: b:btrace -> Lemma (requires (is_Cons b)) (ensures (is_Cons b /\ btrace_t (Cons.tl b))) +val tl_btrace: b:btrace -> Lemma (requires (Cons? b)) (ensures (Cons? b /\ btrace_t (Cons.tl b))) let tl_btrace b = () val append_btrace_lemma: b1:btrace -> b2:btrace -> Lemma (requires (true)) (ensures (btrace_t (append b1 b2))) diff --git a/examples/wysteria/examples/fstar_main/traces.fst b/examples/wysteria/examples/fstar_main/traces.fst index 62c41bd3d6f..449b173b0b9 100644 --- a/examples/wysteria/examples/fstar_main/traces.fst +++ b/examples/wysteria/examples/fstar_main/traces.fst @@ -500,18 +500,18 @@ let rec lemma_row_elim_some b s j0 j = if j0=j then () else lemma_row_elim_some b s (j0 + 1) j -val lemma_row_elims_until: b:seq int -> row:seq entry{Seq.length row = Seq.length b} -> l:list int{is_Cons l} +val lemma_row_elims_until: b:seq int -> row:seq entry{Seq.length row = Seq.length b} -> l:list int{Cons? l} -> i:bound b -> j:ix b{i < j} -> Lemma (requires (l = row_as_list b row i /\ elim_streak row (i + 1) j /\ Seq.index row i <> Elim /\ Seq.index row j <> Elim)) - (ensures (Cons.tl l = row_as_list b row j /\ is_Cons (Cons.tl l))) + (ensures (Cons.tl l = row_as_list b row j /\ Cons? (Cons.tl l))) let lemma_row_elims_until b row l i j = lemma_row_elim_some b row (i + 1) j -val lemma_elim_tail: b:seq int -> row:seq entry{Seq.length row = Seq.length b} -> l:list int{is_Cons l} +val lemma_elim_tail: b:seq int -> row:seq entry{Seq.length row = Seq.length b} -> l:list int{Cons? l} -> j:ix b -> Lemma (requires (l=row_as_list b row j @@ -556,7 +556,7 @@ let next_ith_row_from_false a b i j j' p q = val advance: a:Seq.seq int -> b:Seq.seq int -> i:ix a -> j:ix b -> j':bound b{j p:iter a b i j' -> q:iter a b (i + 1) 0 - -> lb:list int{is_Cons lb} + -> lb:list int{Cons? lb} -> Pure (bound b) (requires (lb=row_as_list b (Matrix2.row p i) j /\ index p i j = NotEqual @@ -633,7 +633,7 @@ let move_elim_streak a b i j j' p q = move_elim_streak' a b i j j' q val next_row_elements: a:_ -> b:_ -> i:ix a{i + 1 < Seq.length a} -> j:ix b -> j':bound b {j < j'} - -> lb:list int{is_Cons lb} + -> lb:list int{Cons? lb} -> p:iter a b i j' -> q:iter a b (i + 1) 0 -> Lemma @@ -645,7 +645,7 @@ val next_row_elements: a:_ -> b:_ -> i:ix a{i + 1 < Seq.length a} -> j:ix b -> j let next_row_elements a b i j j' lb p q = assert (index q i j = NotEqual); assert (index q (i + 1) j = Unknown); - assert (is_Cons (row_as_list b (row q (i + 1)) j)); + assert (Cons? (row_as_list b (row q (i + 1)) j)); assert (Cons.hd (row_as_list b (row q (i + 1)) j) = Cons.hd lb); if j + 1 = j' then () @@ -656,7 +656,7 @@ let next_row_elements a b i j j' lb p q = val advance': a:Seq.seq int -> b:Seq.seq int -> i:ix a -> j:ix b -> j':bound b{j p:iter a b i j' -> q:iter a b (i + 1) 0 - -> lb:list int{is_Cons lb} + -> lb:list int{Cons? lb} -> Pure (bound b) (requires (lb=row_as_list b (Matrix2.row p i) j /\ index p i j = NotEqual diff --git a/examples/wysteria/examples/universes/ffi.fst b/examples/wysteria/examples/universes/ffi.fst index e792842f800..21ee5b5a4ae 100644 --- a/examples/wysteria/examples/universes/ffi.fst +++ b/examples/wysteria/examples/universes/ffi.fst @@ -139,7 +139,7 @@ let slice_option f p = function | None -> None | Some x -> Some (f p x) -val compose_options: ('a -> 'a -> Tot 'a) -> x:option 'a -> y:option 'a{is_Some x <==> is_Some y} -> Tot (option 'a) +val compose_options: ('a -> 'a -> Tot 'a) -> x:option 'a -> y:option 'a{Some? x <==> Some? y} -> Tot (option 'a) let compose_options f x y = match x, y with | None, None -> None | Some x', Some y' -> Some (f x' y') @@ -170,11 +170,11 @@ let rec compose_lists f l1 l2 = match l1, l2 with val slice_list_sps: (prins -> 'a -> Tot 'a) -> prins -> list 'a -> Tot (list 'a) let slice_list_sps f ps l = FStar.List.Tot.map (f ps) l -val hd_of_cons: l:list 'a{is_Cons l} -> Tot 'a +val hd_of_cons: l:list 'a{Cons? l} -> Tot 'a let hd_of_cons = function | hd::_ -> hd -val tl_of_cons: l:list 'a{is_Cons l} -> Tot (list 'a) +val tl_of_cons: l:list 'a{Cons? l} -> Tot (list 'a) let tl_of_cons = function | _::tl -> tl diff --git a/examples/wysteria/examples/universes/wysteria.fsti b/examples/wysteria/examples/universes/wysteria.fsti index 40168010013..8d7ae4ba463 100755 --- a/examples/wysteria/examples/universes/wysteria.fsti +++ b/examples/wysteria/examples/universes/wysteria.fsti @@ -95,9 +95,9 @@ sub_effect PURE ~> WYS = lift_pure_wys val rest_trace: t1:trace -> t2:trace -> Tot (option trace) -val last_elt: t:trace{is_Cons t} -> Tot telt +val last_elt: t:trace{Cons? t} -> Tot telt -val all_but_last: t:trace{is_Cons t} -> Tot trace +val all_but_last: t:trace{Cons? t} -> Tot trace val equal_trace_rest_lemma: t1:trace -> t2:trace -> Lemma (requires (t1 == t2)) @@ -111,22 +111,22 @@ val rest_equal_trace_lemma: t1:trace -> t2:trace val append_rest_lemma: t1:trace -> t2:trace -> t3:trace -> Lemma (requires (append t1 t2 == t3)) - (ensures (is_Some (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) == t2)) + (ensures (Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) == t2)) [SMTPat (rest_trace t3 t1); SMTPat (append t1 t2)] val rest_append_lemma: t1:trace -> t2:trace -> t3:trace - -> Lemma (requires (is_Some (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) == t2)) + -> Lemma (requires (Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) == t2)) (ensures (append t1 t2 == t3)) [SMTPat (rest_trace t3 t1); SMTPat (append t1 t2)] val trace_assoc: t1:trace -> t2:trace -> t3:trace - -> Lemma (requires (is_Some (rest_trace t2 t1) /\ is_Some (rest_trace t3 t2))) - (ensures (is_Some (rest_trace t2 t1) /\ is_Some (rest_trace t3 t2) /\ is_Some (rest_trace t3 t1) /\ + -> Lemma (requires (Some? (rest_trace t2 t1) /\ Some? (rest_trace t3 t2))) + (ensures (Some? (rest_trace t2 t1) /\ Some? (rest_trace t3 t2) /\ Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) == append (Some.v (rest_trace t2 t1)) (Some.v (rest_trace t3 t2)))) [SMTPat (rest_trace t2 t1); SMTPat (rest_trace t3 t2)] -val last_elt_singleton_lemma: t:trace{is_Cons t} +val last_elt_singleton_lemma: t:trace{Cons? t} -> Lemma (requires (all_but_last t == [])) (ensures (t == [last_elt t])) [SMTPat (last_elt t); SMTPat (all_but_last t)] @@ -141,7 +141,7 @@ val snoc_all_but_last_lemma: elt:telt -> t:trace (ensures (all_but_last (t @ [elt]) == t)) [SMTPat (all_but_last (t @ [elt]))] -val all_but_last_append_lemma: t:trace{is_Cons t} -> +val all_but_last_append_lemma: t:trace{Cons? t} -> Lemma (requires (True)) (ensures (append (all_but_last t) ([last_elt t]) == t)) [SMTPat (append (all_but_last t) ([last_elt t]))] @@ -160,7 +160,7 @@ val all_but_last_append_lemma: t:trace{is_Cons t} -> (* type wys_encoding (a:Type) (req:mode -> Type) (ens:mode -> a -> trace -> Type) (p:a -> heap -> Type) (h0:heap) = *) (* req (sel h0 moderef) /\ *) -(* (forall x h1. (sel h1 moderef = sel h0 moderef /\ is_Some (rest_trace (sel h1 traceref) (sel h0 traceref)) /\ *) +(* (forall x h1. (sel h1 moderef = sel h0 moderef /\ Some? (rest_trace (sel h1 traceref) (sel h0 traceref)) /\ *) (* ens (sel h0 moderef) x (Some.v (rest_trace (sel h1 traceref) (sel h0 traceref)))) ==> p x h1) *) (* effect Wys (a:Type) (req:mode -> Type) (ens:mode -> a -> trace -> Type) = *) @@ -176,8 +176,8 @@ val all_but_last_append_lemma: t:trace{is_Cons t} -> (* req (R (sel (R.l h0) moderef) (sel (R.r h0) moderef)) /\ *) (* (forall x h1. (sel (R.l h1) moderef = sel (R.l h0) moderef /\ *) (* sel (R.r h1) moderef = sel (R.r h0) moderef /\ *) -(* is_Some (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref)) /\ *) -(* is_Some (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref)) /\ *) +(* Some? (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref)) /\ *) +(* Some? (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref)) /\ *) (* ens (R (sel (R.l h0) moderef) (sel (R.r h0) moderef)) x *) (* (R (Some.v (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref))) *) (* (Some.v (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref))))) ==> p x h1) *) @@ -285,8 +285,8 @@ val as_par: #a:Type -> #req_f:(mode -> Type) -> #ens_f:(mode -> a -> trace -> Ty -> Wys (box a ps) (fun m0 -> req_f (Mode Par ps) /\ delPar m0 ps /\ can_box a ps) - (fun m0 r t -> is_Cons t /\ Cons.tl t == [] /\ - is_TScope (Cons.hd t) /\ + (fun m0 r t -> Cons? t /\ Cons.tl t == [] /\ + TScope? (Cons.hd t) /\ TScope.ps (Cons.hd t) = ps /\ ens_f (Mode Par ps) (v_of_box r) (TScope.t (Cons.hd t))) @@ -298,7 +298,7 @@ val as_sec: #a:Type -> #req_f:(mode -> Type) -> #ens_f:(mode -> a -> trace -> Ty -> ps:prins -> $f:(unit -> Wys a req_f ens_f) -> Wys a (fun m0 -> req_f (Mode Sec ps) /\ decSec m0 ps) - (fun m0 r t -> is_Cons t /\ last_elt t == TMsg #a r /\ + (fun m0 r t -> Cons? t /\ last_elt t == TMsg #a r /\ ens_f (Mode Sec ps) r (all_but_last t)) (*****) @@ -395,7 +395,7 @@ val comb_sh: #a:Type -> x:sh a (* -> ps:prins *) (* -> $f:(unit -> Wys a req_f ens_f) *) (* -> All a (fun h0 -> req_f (Mode Par ps)) *) -(* (fun h0 r h1 -> is_V r /\ ens_f (Mode Par ps) (V.v r) (sel h1 traceref)) *) +(* (fun h0 r h1 -> V? r /\ ens_f (Mode Par ps) (V.v r) (sel h1 traceref)) *) (*****) diff --git a/examples/wysteria/examples/wysteria.fst b/examples/wysteria/examples/wysteria.fst index 49d258fb971..417deb411ae 100644 --- a/examples/wysteria/examples/wysteria.fst +++ b/examples/wysteria/examples/wysteria.fst @@ -27,12 +27,12 @@ let rec rest_trace t1 t2 = match t2 with | hd'::tl' -> if hd = hd' then rest_trace tl' tl else None -val last_elt: t:trace{is_Cons t} -> Tot telt +val last_elt: t:trace{Cons? t} -> Tot telt let rec last_elt (Cons hd tl) = match tl with | [] -> hd | _ -> last_elt tl -val all_but_last: t:trace{is_Cons t} -> Tot trace +val all_but_last: t:trace{Cons? t} -> Tot trace let rec all_but_last (Cons hd tl) = match tl with | [] -> [] | hd'::tl' -> hd::(all_but_last tl) @@ -60,7 +60,7 @@ let rec rest_equal_trace_lemma t1 t2 = match t2 with val append_rest_lemma: t1:trace -> t2:trace -> t3:trace -> Lemma (requires (append t1 t2 = t3)) - (ensures (is_Some (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) = t2)) + (ensures (Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) = t2)) [SMTPat (rest_trace t3 t1); SMTPat (append t1 t2)] let rec append_rest_lemma t1 t2 t3 = match t1 with | [] -> () @@ -69,7 +69,7 @@ let rec append_rest_lemma t1 t2 t3 = match t1 with | _::tl' -> append_rest_lemma tl t2 tl' val rest_append_lemma: t1:trace -> t2:trace -> t3:trace - -> Lemma (requires (is_Some (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) = t2)) + -> Lemma (requires (Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) = t2)) (ensures (append t1 t2 = t3)) [SMTPat (rest_trace t3 t1); SMTPat (append t1 t2)] let rec rest_append_lemma t1 t2 t3 = match t1 with @@ -79,8 +79,8 @@ let rec rest_append_lemma t1 t2 t3 = match t1 with | _::tl' -> rest_append_lemma tl t2 tl' val trace_assoc: t1:trace -> t2:trace -> t3:trace - -> Lemma (requires (is_Some (rest_trace t2 t1) /\ is_Some (rest_trace t3 t2))) - (ensures (is_Some (rest_trace t2 t1) /\ is_Some (rest_trace t3 t2) /\ is_Some (rest_trace t3 t1) /\ + -> Lemma (requires (Some? (rest_trace t2 t1) /\ Some? (rest_trace t3 t2))) + (ensures (Some? (rest_trace t2 t1) /\ Some? (rest_trace t3 t2) /\ Some? (rest_trace t3 t1) /\ Some.v (rest_trace t3 t1) = append (Some.v (rest_trace t2 t1)) (Some.v (rest_trace t3 t2)))) [SMTPat (rest_trace t2 t1); SMTPat (rest_trace t3 t2)] @@ -92,7 +92,7 @@ let rec trace_assoc t1 t2 t3 = match t1 with match t3 with | _::tl'' -> trace_assoc tl tl' tl'' -val last_elt_singleton_lemma: t:trace{is_Cons t} +val last_elt_singleton_lemma: t:trace{Cons? t} -> Lemma (requires (all_but_last t = [])) (ensures (t = [last_elt t])) [SMTPat (last_elt t); SMTPat (all_but_last t)] @@ -114,7 +114,7 @@ let rec snoc_all_but_last_lemma elt t = match t with | [] -> () | hd::tl -> snoc_all_but_last_lemma elt tl -val all_but_last_append_lemma: t:trace{is_Cons t} -> +val all_but_last_append_lemma: t:trace{Cons? t} -> Lemma (requires (True)) (ensures (append (all_but_last t) ([last_elt t]) = t)) [SMTPat (append (all_but_last t) ([last_elt t]))] @@ -131,7 +131,7 @@ kind Ensures (a:Type) = mode -> a -> trace -> Type type wys_encoding (a:Type) (req:Requires) (ens:Ensures a) (p:a -> heap -> Type) (h0:heap) = req (sel h0 moderef) /\ - (forall x h1. (sel h1 moderef = sel h0 moderef /\ is_Some (rest_trace (sel h1 traceref) (sel h0 traceref)) /\ + (forall x h1. (sel h1 moderef = sel h0 moderef /\ Some? (rest_trace (sel h1 traceref) (sel h0 traceref)) /\ ens (sel h0 moderef) x (Some.v (rest_trace (sel h1 traceref) (sel h0 traceref)))) ==> p x h1) effect Wys (a:Type) (req:Requires) (ens:Ensures a) = @@ -148,8 +148,8 @@ type wys2_encoding (a:Type) (req:Requires2) (ens:Ensures2 a) (p:a -> heap2 -> Ty req (R (sel (R.l h0) moderef) (sel (R.r h0) moderef)) /\ (forall x h1. (sel (R.l h1) moderef = sel (R.l h0) moderef /\ sel (R.r h1) moderef = sel (R.r h0) moderef /\ - is_Some (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref)) /\ - is_Some (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref)) /\ + Some? (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref)) /\ + Some? (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref)) /\ ens (R (sel (R.l h0) moderef) (sel (R.r h0) moderef)) x (R (Some.v (rest_trace (sel (R.l h1) traceref) (sel (R.l h0) traceref))) (Some.v (rest_trace (sel (R.r h1) traceref) (sel (R.r h0) traceref))))) ==> p x h1) @@ -303,8 +303,8 @@ abstract val as_par: #a:Type -> #req_f:(mode -> Type) -> #ens_f:(mode -> a -> tr -> Wys (Box a ps) (fun m0 -> req_f (Mode Par ps) /\ DelPar m0 ps /\ can_box a ps) - (fun m0 r t -> is_Cons t /\ Cons.tl t = [] /\ - is_TScope (Cons.hd t) /\ + (fun m0 r t -> Cons? t /\ Cons.tl t = [] /\ + TScope? (Cons.hd t) /\ TScope.ps (Cons.hd t) = ps /\ ens_f (Mode Par ps) (v_of_box r) (TScope.t (Cons.hd t))) let as_par ps f = @@ -326,7 +326,7 @@ val as_sec: #a:Type -> #req_f:(mode -> Type) -> #ens_f:(mode -> a -> trace -> Ty -> ps:prins -> =f:(unit -> Wys a req_f ens_f) -> Wys a (fun m0 -> req_f (Mode Sec ps) /\ DelSec m0 ps) - (fun m0 r t -> is_Cons t /\ last_elt t = TMsg #a r /\ + (fun m0 r t -> Cons? t /\ last_elt t = TMsg #a r /\ ens_f (Mode Sec ps) r (all_but_last t)) let as_sec ps f = let m0 = ST.read moderef in @@ -434,7 +434,7 @@ val main: #a:Type -> #req_f:(mode -> Type) -> #ens_f:(mode -> a -> trace -> Type -> ps:prins -> =f:(unit -> Wys a req_f ens_f) -> All a (fun h0 -> req_f (Mode Par ps)) - (fun h0 r h1 -> is_V r /\ ens_f (Mode Par ps) (V.v r) (sel h1 traceref)) + (fun h0 r h1 -> V? r /\ ens_f (Mode Par ps) (V.v r) (sel h1 traceref)) let main ps f = ST.write moderef (Mode Par ps); diff --git a/examples/wysteria/ffibridge.fsti b/examples/wysteria/ffibridge.fsti index 30b75c4775f..a845a63c843 100644 --- a/examples/wysteria/ffibridge.fsti +++ b/examples/wysteria/ffibridge.fsti @@ -8,9 +8,9 @@ type compose_fn_wrapper = | Mk_c_w: ('a -> 'a -> Tot 'a) -> compose_fn_wrapper val compose_v_opaques: #m1:v_meta -> #m2:v_meta - -> v1:value m1{is_V_opaque v1} -> v2:value m2{is_V_opaque v2} + -> v1:value m1{V_opaque? v1} -> v2:value m2{V_opaque? v2} -> Tot (dv:dvalue{D_v.meta dv = compose_opaque_meta m1 m2 /\ - is_V_opaque (D_v.v dv) /\ + V_opaque? (D_v.v dv) /\ Mk_c_w (V_opaque.compose_fn (D_v.v dv)) = Mk_c_w (V_opaque.compose_fn v1)}) diff --git a/examples/wysteria/interpreter.fst b/examples/wysteria/interpreter.fst index 537e5e0c6a1..df823c2520c 100644 --- a/examples/wysteria/interpreter.fst +++ b/examples/wysteria/interpreter.fst @@ -16,33 +16,33 @@ open Crypto val step: c:config -> Tot (option config) let step c = if pre_easpar c then Some (step_aspar_e1 c) - else if is_value_ps c && is_sframe c is_F_aspar_ps then Some (step_aspar_e2 c) - else if is_value c && is_sframe c is_F_aspar_e then Some (step_aspar_red c) + else if is_value_ps c && is_sframe c F_aspar_ps? then Some (step_aspar_e2 c) + else if is_value c && is_sframe c F_aspar_e? then Some (step_aspar_red c) else if not (pre_aspar c = NA) then Some (step_aspar c) else if pre_aspar_ret c = Do then Some (step_aspar_ret c) else if pre_ebox c then Some (step_box_e1 c) - else if is_value_ps c && is_sframe c is_F_box_ps then Some (step_box_e2 c) - else if is_value c && is_sframe c is_F_box_e then Some (step_box_red c) + else if is_value_ps c && is_sframe c F_box_ps? then Some (step_box_e2 c) + else if is_value c && is_sframe c F_box_e? then Some (step_box_red c) else if pre_box c = Do then Some (step_box c) else if pre_eunbox c then Some (step_unbox_e c) - else if is_value c && is_sframe c is_F_unbox then Some (step_unbox_red c) + else if is_value c && is_sframe c F_unbox? then Some (step_unbox_red c) else if pre_unbox c = Do then Some (step_unbox c) else if pre_emkwire c then Some (step_mkwire_e1 c) - else if is_value_ps c && is_sframe c is_F_mkwire_ps then Some (step_mkwire_e2 c) - else if is_value c && is_sframe c is_F_mkwire_e then Some (step_mkwire_red c) + else if is_value_ps c && is_sframe c F_mkwire_ps? then Some (step_mkwire_e2 c) + else if is_value c && is_sframe c F_mkwire_e? then Some (step_mkwire_red c) else if pre_mkwire c = Do then Some (step_mkwire c) else if pre_eprojwire c then Some (step_projwire_e1 c) - else if is_value_p c && is_sframe c is_F_projwire_p then Some (step_projwire_e2 c) - else if is_value c && is_sframe c is_F_projwire_e then Some (step_projwire_red c) + else if is_value_p c && is_sframe c F_projwire_p? then Some (step_projwire_e2 c) + else if is_value c && is_sframe c F_projwire_e? then Some (step_projwire_red c) else if pre_projwire c = Do then Some (step_projwire c) else if pre_econcatwire c then Some (step_concatwire_e1 c) - else if is_value c && is_sframe c is_F_concatwire_e1 then Some (step_concatwire_e2 c) - else if is_value c && is_sframe c is_F_concatwire_e2 then Some (step_concatwire_red c) + else if is_value c && is_sframe c F_concatwire_e1? then Some (step_concatwire_e2 c) + else if is_value c && is_sframe c F_concatwire_e2? then Some (step_concatwire_red c) else if pre_concatwire c = Do then Some (step_concatwire c) else if pre_econst c then Some (step_const c) @@ -50,7 +50,7 @@ let step c = else if pre_evar c then Some (step_var c) else if pre_elet c then Some (step_let_e1 c) - else if is_value c && is_sframe c is_F_let then Some (step_let_red c) + else if is_value c && is_sframe c F_let? then Some (step_let_red c) else if pre_let c then Some (step_let c) else if pre_eabs c then Some (step_abs c) @@ -60,66 +60,66 @@ let step c = else if pre_eempabs c then Some (step_empabs c) else if pre_eapp c then Some (step_app_e1 c) - else if is_value c && is_sframe c is_F_app_e1 then Some (step_app_e2 c) - else if is_value c && is_sframe c is_F_app_e2 then Some (step_app_red c) + else if is_value c && is_sframe c F_app_e1? then Some (step_app_e2 c) + else if is_value c && is_sframe c F_app_e2? then Some (step_app_red c) else if pre_app c then Some (step_app c) else if pre_effi c then Some (step_ffi_e c) - else if is_value c && is_sframe c is_F_ffi then Some (step_ffi_l c) + else if is_value c && is_sframe c F_ffi? then Some (step_ffi_l c) else if pre_ffi c = Do then Some (step_ffi c) else if pre_econd c then Some (step_cond_e c) - else if is_value c && is_sframe c is_F_cond then Some (step_cond_red c) + else if is_value c && is_sframe c F_cond? then Some (step_cond_red c) else if pre_cond c then Some (step_cond c) else if pre_eassec c then Some (step_assec_e1 c) - else if is_value_ps c && is_sframe c is_F_assec_ps then Some (step_assec_e2 c) - else if is_value c && is_sframe c is_F_assec_e then Some (step_assec_red c) + else if is_value_ps c && is_sframe c F_assec_ps? then Some (step_assec_e2 c) + else if is_value c && is_sframe c F_assec_e? then Some (step_assec_red c) else if not (pre_assec c = NA) then Some (step_assec c) - else if is_value c && is_sframe c is_F_assec_ret then Some (step_assec_ret c) + else if is_value c && is_sframe c F_assec_ret? then Some (step_assec_ret c) else if pre_emksh c then Some (step_mksh_e c) - else if is_value c && is_sframe c is_F_mksh then Some (step_mksh_red c) + else if is_value c && is_sframe c F_mksh? then Some (step_mksh_red c) else if not (pre_mksh c = NA) then Some (step_mksh c) else if pre_ecombsh c then Some (step_combsh_e c) - else if is_value c && is_sframe c is_F_combsh then Some (step_combsh_red c) + else if is_value c && is_sframe c F_combsh? then Some (step_combsh_red c) else if not (pre_combsh c = NA) then Some (step_combsh c) else None -val step_correctness: c:config{is_Some (step c)} -> Tot (sstep c (Some.v (step c))) +val step_correctness: c:config{Some? (step c)} -> Tot (sstep c (Some.v (step c))) let step_correctness c = let c' = v_of_some (step c) in if pre_easpar c then C_aspar_ps c c' - else if is_value_ps c && is_sframe c is_F_aspar_ps then C_aspar_e c c' - else if is_value c && is_sframe c is_F_aspar_e then C_aspar_red c c' + else if is_value_ps c && is_sframe c F_aspar_ps? then C_aspar_e c c' + else if is_value c && is_sframe c F_aspar_e? then C_aspar_red c c' else if not (pre_aspar c = NA) then C_aspar_beta c c' else if pre_aspar_ret c = Do then C_aspar_ret c c' else if pre_ebox c then C_box_ps c c' - else if is_value_ps c && is_sframe c is_F_box_ps then C_box_e c c' - else if is_value c && is_sframe c is_F_box_e then C_box_red c c' + else if is_value_ps c && is_sframe c F_box_ps? then C_box_e c c' + else if is_value c && is_sframe c F_box_e? then C_box_red c c' else if pre_box c = Do then C_box_beta c c' else if pre_eunbox c then C_unbox c c' - else if is_value c && is_sframe c is_F_unbox then C_unbox_red c c' + else if is_value c && is_sframe c F_unbox? then C_unbox_red c c' else if pre_unbox c = Do then C_unbox_beta c c' else if pre_emkwire c then C_mkwire_e1 c c' - else if is_value_ps c && is_sframe c is_F_mkwire_ps then C_mkwire_e2 c c' - else if is_value c && is_sframe c is_F_mkwire_e then C_mkwire_red c c' + else if is_value_ps c && is_sframe c F_mkwire_ps? then C_mkwire_e2 c c' + else if is_value c && is_sframe c F_mkwire_e? then C_mkwire_red c c' else if pre_mkwire c = Do then C_mkwire_beta c c' else if pre_eprojwire c then C_projwire_p c c' - else if is_value_p c && is_sframe c is_F_projwire_p then C_projwire_e c c' - else if is_value c && is_sframe c is_F_projwire_e then C_projwire_red c c' + else if is_value_p c && is_sframe c F_projwire_p? then C_projwire_e c c' + else if is_value c && is_sframe c F_projwire_e? then C_projwire_red c c' else if pre_projwire c = Do then C_projwire_beta c c' else if pre_econcatwire c then C_concatwire_e1 c c' - else if is_value c && is_sframe c is_F_concatwire_e1 then C_concatwire_e2 c c' - else if is_value c && is_sframe c is_F_concatwire_e2 then C_concatwire_red c c' + else if is_value c && is_sframe c F_concatwire_e1? then C_concatwire_e2 c c' + else if is_value c && is_sframe c F_concatwire_e2? then C_concatwire_red c c' else if pre_concatwire c = Do then C_concatwire_beta c c' else if pre_econst c then C_const c c' @@ -127,7 +127,7 @@ let step_correctness c = else if pre_evar c then C_var c c' else if pre_elet c then C_let_e1 c c' - else if is_value c && is_sframe c is_F_let then C_let_red c c' + else if is_value c && is_sframe c F_let? then C_let_red c c' else if pre_let c then C_let_beta c c' else if pre_eabs c then C_abs c c' @@ -137,40 +137,40 @@ let step_correctness c = else if pre_eempabs c then C_empabs c c' else if pre_eapp c then C_app_e1 c c' - else if is_value c && is_sframe c is_F_app_e1 then C_app_e2 c c' - else if is_value c && is_sframe c is_F_app_e2 then C_app_red c c' + else if is_value c && is_sframe c F_app_e1? then C_app_e2 c c' + else if is_value c && is_sframe c F_app_e2? then C_app_red c c' else if pre_app c then C_app_beta c c' else if pre_effi c then C_ffi_e c c' - else if is_value c && is_sframe c is_F_ffi then C_ffi_l c c' + else if is_value c && is_sframe c F_ffi? then C_ffi_l c c' else if pre_ffi c = Do then C_ffi_beta c c' else if pre_econd c then C_cond_e c c' - else if is_value c && is_sframe c is_F_cond then C_cond_red c c' + else if is_value c && is_sframe c F_cond? then C_cond_red c c' else if pre_cond c then C_cond_beta c c' else if pre_eassec c then C_assec_ps c c' - else if is_value_ps c && is_sframe c is_F_assec_ps then C_assec_e c c' - else if is_value c && is_sframe c is_F_assec_e then C_assec_red c c' + else if is_value_ps c && is_sframe c F_assec_ps? then C_assec_e c c' + else if is_value c && is_sframe c F_assec_e? then C_assec_red c c' else if not (pre_assec c = NA) then C_assec_beta c c' - else if is_value c && is_sframe c is_F_assec_ret then C_assec_ret c c' + else if is_value c && is_sframe c F_assec_ret? then C_assec_ret c c' else if pre_emksh c then C_mksh c c' - else if is_value c && is_sframe c is_F_mksh then C_mksh_red c c' + else if is_value c && is_sframe c F_mksh? then C_mksh_red c c' else if not (pre_mksh c = NA) then C_mksh_beta c c' else if pre_ecombsh c then C_combsh c c' - else if is_value c && is_sframe c is_F_combsh then C_combsh_red c c' + else if is_value c && is_sframe c F_combsh? then C_combsh_red c c' else C_combsh_beta c c' -val step_completeness: c:config -> c':config -> h:sstep c c' -> Lemma (requires (True)) (ensures (is_Some (step c))) +val step_completeness: c:config -> c':config -> h:sstep c c' -> Lemma (requires (True)) (ensures (Some? (step c))) let step_completeness c c' h = () #reset-options "--z3timeout 10" val target_step_lemma: p:prin -> c:config{Conf.l c = Target /\ Conf.m c = Mode Par (singleton p) /\ - is_Some (step c)} + Some? (step c)} -> c':config{c' = Some.v (step c)} -> Lemma (requires (True)) (ensures (Conf.l c' = Target /\ Conf.m c' = Mode Par (singleton p))) @@ -219,7 +219,7 @@ opaque type witness_client_config (#a:Type) (x:a) = True (* k *) val do_sec_comp: - p:prin -> c:tstep_config p{is_T_red (Conf.t c) /\ is_R_assec (T_red.r (Conf.t c)) + p:prin -> c:tstep_config p{T_red? (Conf.t c) /\ R_assec? (T_red.r (Conf.t c)) /\ is_clos (R_assec.v (T_red.r (Conf.t c)))} -> ML dvalue let do_sec_comp p c = @@ -259,7 +259,7 @@ let do_sec_comp p c = val tstep: p:prin -> tstep_config p -> ML (option (tstep_config p)) let tstep p c = let Conf l m s en t _ = c in - if is_T_red t && is_R_assec (T_red.r t) && is_clos (R_assec.v (T_red.r (Conf.t c))) then + if T_red? t && R_assec? (T_red.r t) && is_clos (R_assec.v (T_red.r (Conf.t c))) then let dv = do_sec_comp p c in Some (Conf l m s en (T_val #(D_v.meta dv) (D_v.v dv)) (hide [])) else diff --git a/examples/wysteria/main.fst b/examples/wysteria/main.fst index 305f15888c7..d74c154a739 100644 --- a/examples/wysteria/main.fst +++ b/examples/wysteria/main.fst @@ -30,7 +30,7 @@ else | Some (D_v _ (V_prin p)) -> let c = Conf Target (Mode Par (OrdSet.singleton p)) [] init_env (T_exp Prog.program) (hide []) in let c' = tstep_star p c in - if is_Some c' then + if Some? c' then let Some c' = c' in () else diff --git a/examples/wysteria/psem.fst b/examples/wysteria/psem.fst index 77f9c8eaec3..d89fef7060d 100644 --- a/examples/wysteria/psem.fst +++ b/examples/wysteria/psem.fst @@ -40,8 +40,8 @@ type tpre_assec (#ps':prins) (pi:protocol ps') (ps:prins) (x:varname) (e:exp) = (forall p. mem p ps ==> (contains p (fst pi) /\ Let (Some.v (select p (fst pi))) (fun c -> - is_T_red (Conf.t c) /\ - is_R_assec (T_red.r (Conf.t c)) /\ + T_red? (Conf.t c) /\ + R_assec? (T_red.r (Conf.t c)) /\ R_assec.ps (T_red.r (Conf.t c)) = ps /\ is_clos (R_assec.v (T_red.r (Conf.t c))) /\ MkTuple3._2 (get_en_b (R_assec.v (T_red.r (Conf.t c)))) = x /\ @@ -51,8 +51,8 @@ opaque val get_env_m: #ps':prins -> pi:protocol ps' -> ps:prins{forall p. (mem p ps ==> contains p (fst pi) /\ Let (Some.v (select p (fst pi))) - (fun c -> is_T_red (Conf.t c) /\ - is_R_assec (T_red.r (Conf.t c)) /\ + (fun c -> T_red? (Conf.t c) /\ + R_assec? (T_red.r (Conf.t c)) /\ is_clos (R_assec.v (T_red.r (Conf.t c)))))} -> Tot (m:env_map ps{(forall p. (mem p ps ==> select p m = Some ( @@ -100,9 +100,9 @@ let tstep_assec #ps' pi ps x e = (step_ps_to_wait #ps' (fst pi) ps, update ps tsec (snd pi)) type waiting_config (c:tconfig) = - is_T_sec_wait (Conf.t c) /\ - is_Cons (Conf.s c) /\ - is_F_assec_ret (Frame.f (Cons.hd (Conf.s c))) + T_sec_wait? (Conf.t c) /\ + Cons? (Conf.s c) /\ + F_assec_ret? (Frame.f (Cons.hd (Conf.s c))) type ps_sec_waiting (#ps':prins) (pi:protocol ps') (ps:prins) = (forall p. mem p ps ==> (contains p (fst pi) /\ waiting_config (Some.v (select p (fst pi))))) diff --git a/examples/wysteria/rtheory.fst b/examples/wysteria/rtheory.fst index ab666e34696..a8ab23a4734 100644 --- a/examples/wysteria/rtheory.fst +++ b/examples/wysteria/rtheory.fst @@ -26,11 +26,11 @@ opaque type tpre_assec' (ps:prins) (ps':prins) (pi:tpar ps') (x:varname) (e:exp) (contains p en_m /\ contains p red_m /\ (Let (Some.v (select p pi)) (fun c -> - is_T_red (Conf.t c) /\ + T_red? (Conf.t c) /\ (Let (T_red.r (Conf.t c)) (fun r -> r = Some.v (select p red_m) /\ - is_R_assec r /\ R_assec.ps r = ps /\ is_clos (R_assec.v r) /\ + R_assec? r /\ R_assec.ps r = ps /\ is_clos (R_assec.v r) /\ MkTuple3._2 (get_en_b (R_assec.v r)) = x /\ MkTuple3._3 (get_en_b (R_assec.v r)) = e /\ Some.v (select p en_m) = MkTuple3._1 (get_en_b (R_assec.v r))))))) @@ -63,7 +63,7 @@ opaque type final_prop (ps:prins) (pi:tpar ps) (c:config{is_value c}) = forall p.{:pattern (contains p pi)} contains p pi ==> (Let (Conf.t (Some.v (select p pi))) (fun t -> - is_T_val t /\ + T_val? t /\ (Let (D_v (T_val.meta t) (T_val.v t)) (fun dvt -> b2t (dvt = slice_v #(T_val.meta (Conf.t c)) p @@ -232,11 +232,11 @@ let create_pstep_star ps en_m red_m x e c_sec h pi = (* val sec_enter_is_parametric: *) (* ps:prins -> pi:protocol ps -> pi':protocol ps *) -(* -> h:pstep #ps pi pi'{is_P_sec_enter h /\ P_sec_enter.ps h = ps} *) +(* -> h:pstep #ps pi pi'{P_sec_enter? h /\ P_sec_enter.ps h = ps} *) (* -> p:prin{contains p (fst pi)} -> c:tconfig_par{same_c (Some.v (select p (fst pi))) c} *) (* -> Tot (h':(pstep #ps (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi) *) (* (update #prin #tconfig_par #p_cmp p (step_p_to_wait c p) (fst pi'), snd pi')) *) -(* {is_P_sec_enter h'}) *) +(* {P_sec_enter? h'}) *) (* let sec_enter_is_parametric ps pi pi' h p c = *) (* let x = P_sec_enter.x h in *) (* let e = P_sec_enter.e h in *) @@ -265,18 +265,18 @@ let create_pstep_star ps en_m red_m x e c_sec h pi = (* val sec_step_is_parametric: *) (* ps:prins -> pi:protocol ps -> pi':protocol ps *) -(* -> h:pstep #ps pi pi'{is_P_sec h /\ P_sec.ps h = ps} *) +(* -> h:pstep #ps pi pi'{P_sec? h /\ P_sec.ps h = ps} *) (* -> p:prin{contains p (fst pi)} -> c:tconfig_par{same_c (Some.v (select p (fst pi))) c} *) (* -> Tot (h':(pstep #ps (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi) *) (* (update #prin #tconfig_par #p_cmp p c (fst pi), snd pi')) *) -(* {is_P_sec h'}) *) +(* {P_sec? h'}) *) (* let sec_step_is_parametric ps pi pi' h p c = *) (* P_sec #ps #(P_sec.c' h) (update p c (fst pi), snd pi) ps (P_sec.h h) (update p c (fst pi), snd pi') *) (* val all_sec_steps: ps:prins -> pi:protocol ps -> pi':protocol ps -> h:pstep_star #ps pi pi' -> Tot bool (decreases h) *) (* let rec all_sec_steps ps pi pi' = function *) (* | PS_refl _ -> true *) -(* | PS_tran #ps #pi #pi' #pi'' h1 h2 -> is_P_sec h1 && P_sec.ps h1 = ps && all_sec_steps ps pi' pi'' h2 *) +(* | PS_tran #ps #pi #pi' #pi'' h1 h2 -> P_sec? h1 && P_sec.ps h1 = ps && all_sec_steps ps pi' pi'' h2 *) (* val sec_step_star_is_parametric: *) (* ps:prins -> pi:protocol ps -> pi':protocol ps -> h:pstep_star #ps pi pi'{all_sec_steps ps pi pi' h} *) @@ -313,7 +313,7 @@ let create_pstep_star ps en_m red_m x e c_sec h pi = (* -> pi:protocol ps *) (* -> pi_enter:protocol ps *) (* -> pi_final:protocol ps{contains ps (snd pi_final) /\ is_sterminal (Some.v (select ps (snd pi_final)))} *) -(* -> h1:pstep #ps pi pi_enter{is_P_sec_enter h1 /\ P_sec_enter.ps h1 = ps} *) +(* -> h1:pstep #ps pi pi_enter{P_sec_enter? h1 /\ P_sec_enter.ps h1 = ps} *) (* -> h2:pstep_star #ps pi_enter pi_final{all_sec_steps ps pi_enter pi_final h2} *) (* -> p:prin{contains p (fst pi)} -> c:tconfig_par{same_c (Some.v (select p (fst pi))) c} *) (* -> Lemma (requires (True)) *) diff --git a/examples/wysteria/sec_server.fst b/examples/wysteria/sec_server.fst index d6b117c1141..0fb013872cb 100644 --- a/examples/wysteria/sec_server.fst +++ b/examples/wysteria/sec_server.fst @@ -57,7 +57,7 @@ let do_sec_comp' c = (* Using non opaque types as patterns is risky *) opaque type config_prop (ps:prins) (x:varname) (e:exp) (p:prin) (r:redex) (c:config) = - mem p ps /\ is_R_assec r /\ is_clos (R_assec.v r) /\ R_assec.ps r = ps /\ + mem p ps /\ R_assec? r /\ is_clos (R_assec.v r) /\ R_assec.ps r = ps /\ MkTuple3._2 (get_en_b (R_assec.v r)) = x /\ MkTuple3._3 (get_en_b (R_assec.v r)) = e /\ Conf.t c = T_red r /\ Conf.l c = Target /\ Conf.m c = Mode Par (singleton p) @@ -93,7 +93,7 @@ val build_pi_lemma: -> red_m:redex_map{forall p.{:pattern (mem p ps')} mem p ps' = contains p red_m} -> x:varname -> e:exp -> p:prin - -> r:redex{is_R_assec r /\ is_clos (R_assec.v r) /\ R_assec.ps r = ps /\ + -> r:redex{R_assec? r /\ is_clos (R_assec.v r) /\ R_assec.ps r = ps /\ MkTuple3._2 (get_en_b (R_assec.v r)) = x /\ MkTuple3._3 (get_en_b (R_assec.v r)) = e} -> Lemma (requires (exists (c:config) (pi:tpar ps'). @@ -226,7 +226,7 @@ let build_initial_pi ps p x e r c = val build_initial_pi_lemma: ps:prins -> p:prin{mem p ps} -> x:varname -> e:exp - -> r:redex{is_R_assec r /\ is_clos (R_assec.v r) /\ + -> r:redex{R_assec? r /\ is_clos (R_assec.v r) /\ R_assec.ps r = ps /\ MkTuple3._2 (get_en_b (R_assec.v r)) = x /\ MkTuple3._3 (get_en_b (R_assec.v r)) = e} diff --git a/examples/wysteria/sem.fst b/examples/wysteria/sem.fst index b4193129222..ef3c084d48a 100644 --- a/examples/wysteria/sem.fst +++ b/examples/wysteria/sem.fst @@ -18,7 +18,7 @@ val is_empty: eprins -> Tot bool let is_empty s = size s = 0 (* TODO: FIXME: workaround for projectors *) -val e_of_t_exp: t:term{is_T_exp t} -> Tot exp +val e_of_t_exp: t:term{T_exp? t} -> Tot exp let e_of_t_exp (T_exp e) = e val concat_traces: erased trace -> erased trace -> Tot (erased trace) @@ -61,19 +61,19 @@ let vals_traces_concat_lemma tr1 tr2 = //----- aspar e1 e2 -----// let pre_easpar (c:config) = - is_T_exp (t_of_conf c) && is_E_aspar (e_of_t_exp (t_of_conf c)) && is_par c + T_exp? (t_of_conf c) && E_aspar? (e_of_t_exp (t_of_conf c)) && is_par c val step_aspar_e1: c:config{pre_easpar c} -> Tot config let step_aspar_e1 (Conf l m s en (T_exp (E_aspar e1 e2)) tr) = Conf l m ((Frame m en (F_aspar_ps e2) tr)::s) en (T_exp e1) (hide []) -val step_aspar_e2: c:config{is_value_ps c /\ is_sframe c is_F_aspar_ps} +val step_aspar_e2: c:config{is_value_ps c /\ is_sframe c F_aspar_ps?} -> Tot config let step_aspar_e2 (Conf l _ ((Frame m en (F_aspar_ps e) tr)::s) _ (T_val (V_eprins ps)) tr') = Conf l m ((Frame m en (F_aspar_e ps) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_aspar_red: c:config{is_value c /\ is_sframe c is_F_aspar_e} +val step_aspar_red: c:config{is_value c /\ is_sframe c F_aspar_e?} -> Tot config let step_aspar_red (Conf l _ ((Frame m en (F_aspar_e ps) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_aspar ps v)) (concat_traces tr tr') @@ -136,19 +136,19 @@ let step_aspar_ret c = match c with // ----- box e1 e2 -----// let pre_ebox (c:config) = - is_T_exp (t_of_conf c) && is_E_box (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_box? (e_of_t_exp (t_of_conf c)) val step_box_e1: c:config{pre_ebox c} -> Tot config let step_box_e1 (Conf l m s en (T_exp (E_box e1 e2)) tr) = Conf l m ((Frame m en (F_box_ps e2) tr)::s) en (T_exp e1) (hide []) -val step_box_e2: c:config{is_value_ps c /\ is_sframe c is_F_box_ps} +val step_box_e2: c:config{is_value_ps c /\ is_sframe c F_box_ps?} -> Tot config let step_box_e2 (Conf l _ ((Frame m en (F_box_ps e) tr)::s) _ (T_val (V_eprins ps)) tr') = Conf l m ((Frame m en (F_box_e ps) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_box_red: c:config{is_value c /\ is_sframe c is_F_box_e} +val step_box_red: c:config{is_value c /\ is_sframe c F_box_e?} -> Tot config let step_box_red (Conf l _ ((Frame m en (F_box_e ps) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_box ps v)) (concat_traces tr tr') @@ -178,18 +178,18 @@ let step_box (Conf l m s en (T_red (R_box ps' v)) tr) = //----- app e1 e2 -----// let pre_eapp (c:config) = - is_T_exp (t_of_conf c) && is_E_app (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_app? (e_of_t_exp (t_of_conf c)) val step_app_e1: c:config{pre_eapp c} -> Tot config let step_app_e1 (Conf l m s en (T_exp (E_app e1 e2)) tr) = Conf l m ((Frame m en (F_app_e1 e2) tr)::s) en (T_exp e1) (hide []) -val step_app_e2: c:config{is_value c /\ is_sframe c is_F_app_e1} +val step_app_e2: c:config{is_value c /\ is_sframe c F_app_e1?} -> Tot config let step_app_e2 (Conf l _ ((Frame m en (F_app_e1 e2) tr)::s) _ (T_val v) tr') = Conf l m ((Frame m en (F_app_e2 v) (concat_traces tr tr'))::s) en (T_exp e2) (hide []) -val step_app_red: c:config{is_value c /\ is_sframe c is_F_app_e2} +val step_app_red: c:config{is_value c /\ is_sframe c F_app_e2?} -> Tot config let step_app_red (Conf l _ ((Frame m en (F_app_e2 v1) tr)::s) _ (T_val v2) tr') = Conf l m s en (T_red (R_app v1 v2)) (concat_traces tr tr') @@ -211,7 +211,7 @@ let step_app c = match c with //----- fun x.e -----// let pre_eabs (c:config) = - is_T_exp (t_of_conf c) && is_E_abs (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_abs? (e_of_t_exp (t_of_conf c)) val step_abs: c:config{pre_eabs c} -> Tot config let step_abs (Conf l m s en (T_exp (E_abs x e)) tr) = @@ -222,7 +222,7 @@ let step_abs (Conf l m s en (T_exp (E_abs x e)) tr) = //----- fix f.fun x.e -----// let pre_efix (c:config) = - is_T_exp (t_of_conf c) && is_E_fix (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_fix? (e_of_t_exp (t_of_conf c)) val step_fix: c:config{pre_efix c} -> Tot config let step_fix (Conf l m s en (T_exp (E_fix f x e)) tr) = @@ -233,7 +233,7 @@ let step_fix (Conf l m s en (T_exp (E_fix f x e)) tr) = //----- fun x.e (closed) -----// let pre_eempabs (c:config) = - is_T_exp (t_of_conf c) && is_E_empabs (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_empabs? (e_of_t_exp (t_of_conf c)) val step_empabs: c:config{pre_eempabs c} -> Tot config let step_empabs (Conf l m s en (T_exp (E_empabs x e)) tr) = @@ -244,13 +244,13 @@ let step_empabs (Conf l m s en (T_exp (E_empabs x e)) tr) = //----- let x = e1 in e2 -----// let pre_elet (c:config) = - is_T_exp (t_of_conf c) && is_E_let (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_let? (e_of_t_exp (t_of_conf c)) val step_let_e1: c:config{pre_elet c} -> Tot config let step_let_e1 (Conf l m s en (T_exp (E_let x e1 e2)) tr) = Conf l m ((Frame m en (F_let x e2) tr)::s) en (T_exp e1) (hide []) -val step_let_red: c:config{is_value c /\ is_sframe c is_F_let} +val step_let_red: c:config{is_value c /\ is_sframe c F_let?} -> Tot config let step_let_red (Conf l _ ((Frame m en (F_let x e2) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_let x v e2)) (concat_traces tr tr') @@ -270,12 +270,12 @@ let step_let c = match c with //----- x -----// (* TODO: FIXME: workaround for projectors *) -val x_of_e_var: e:exp{is_E_var e} -> Tot varname +val x_of_e_var: e:exp{E_var? e} -> Tot varname let x_of_e_var (E_var x) = x (* TODO: FIXME: workaround for projectors *) -val is_Some: option 'a -> Tot bool -let is_Some x = match x with +val Some?: option 'a -> Tot bool +let Some? x = match x with | Some _ -> true | _ -> false @@ -284,8 +284,8 @@ val en_of_conf: config -> Tot env let en_of_conf (Conf _ _ _ en _ _) = en let pre_evar (c:config) = - is_T_exp (t_of_conf c) && is_E_var (e_of_t_exp (t_of_conf c)) && - is_Some ((en_of_conf c) (x_of_e_var (e_of_t_exp (t_of_conf c)))) + T_exp? (t_of_conf c) && E_var? (e_of_t_exp (t_of_conf c)) && + Some? ((en_of_conf c) (x_of_e_var (e_of_t_exp (t_of_conf c)))) val step_var: c:config{pre_evar c} -> Tot config let step_var (Conf l m s en (T_exp (E_var x)) tr) = @@ -297,7 +297,7 @@ let step_var (Conf l m s en (T_exp (E_var x)) tr) = //----- c -----// let pre_econst (c:config) = - is_T_exp (t_of_conf c) && is_E_const (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_const? (e_of_t_exp (t_of_conf c)) val slice_const: p:prin -> 'a -> Tot 'a let slice_const p x = x @@ -328,13 +328,13 @@ let step_const (Conf l m s en (T_exp (E_const c)) tr) = //----- unbox e -----// let pre_eunbox (c:config) = - is_T_exp (t_of_conf c) && is_E_unbox (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_unbox? (e_of_t_exp (t_of_conf c)) val step_unbox_e: c:config{pre_eunbox c} -> Tot config let step_unbox_e (Conf l m s en (T_exp (E_unbox e)) tr) = Conf l m ((Frame m en F_unbox tr)::s) en (T_exp e) (hide []) -val step_unbox_red: c:config{is_value c /\ is_sframe c is_F_unbox} +val step_unbox_red: c:config{is_value c /\ is_sframe c F_unbox?} -> Tot config let step_unbox_red (Conf l _ ((Frame m en F_unbox tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_unbox v)) (concat_traces tr tr') @@ -358,19 +358,19 @@ let step_unbox c = match c with //----- mkwire e1 e2 -----// let pre_emkwire (c:config) = - is_T_exp (t_of_conf c) && is_E_mkwire (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_mkwire? (e_of_t_exp (t_of_conf c)) val step_mkwire_e1: c:config{pre_emkwire c} -> Tot config let step_mkwire_e1 (Conf l m s en (T_exp (E_mkwire e1 e2)) tr) = Conf l m ((Frame m en (F_mkwire_ps e2) tr)::s) en (T_exp e1) (hide []) -val step_mkwire_e2: c:config{is_value_ps c /\ is_sframe c is_F_mkwire_ps} +val step_mkwire_e2: c:config{is_value_ps c /\ is_sframe c F_mkwire_ps?} -> Tot config let step_mkwire_e2 (Conf l _ ((Frame m en (F_mkwire_ps e) tr)::s) _ (T_val (V_eprins ps)) tr') = Conf l m ((Frame m en (F_mkwire_e ps) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_mkwire_red: c:config{is_value c /\ is_sframe c is_F_mkwire_e} +val step_mkwire_red: c:config{is_value c /\ is_sframe c F_mkwire_e?} -> Tot config let step_mkwire_red (Conf l _ ((Frame m en (F_mkwire_e ps) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_mkwire ps v)) (concat_traces tr tr') @@ -418,19 +418,19 @@ let step_mkwire c = match c with //----- projwire e1 e2 -----// let pre_eprojwire (c:config) = - is_T_exp (t_of_conf c) && is_E_projwire (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_projwire? (e_of_t_exp (t_of_conf c)) val step_projwire_e1: c:config{pre_eprojwire c} -> Tot config let step_projwire_e1 (Conf l m s en (T_exp (E_projwire e1 e2)) tr) = Conf l m ((Frame m en (F_projwire_p e2) tr)::s) en (T_exp e1) (hide []) -val step_projwire_e2: c:config{is_value_p c /\ is_sframe c is_F_projwire_p} +val step_projwire_e2: c:config{is_value_p c /\ is_sframe c F_projwire_p?} -> Tot config let step_projwire_e2 (Conf l _ ((Frame m en (F_projwire_p e) tr)::s) _ (T_val (V_prin p)) tr') = Conf l m ((Frame m en (F_projwire_e p) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_projwire_red: c:config{is_value c /\ is_sframe c is_F_projwire_e} +val step_projwire_red: c:config{is_value c /\ is_sframe c F_projwire_e?} -> Tot config let step_projwire_red (Conf l _ ((Frame m en (F_projwire_e p) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_projwire p v)) (concat_traces tr tr') @@ -446,7 +446,7 @@ let pre_projwire c = match c with | _ -> NA (* TODO: FIXME: workaround for projectors *) -val v_of_some: x:option 'a{is_Some x} -> Tot 'a +val v_of_some: x:option 'a{Some? x} -> Tot 'a let v_of_some (Some x) = x val step_projwire: c:config{pre_projwire c = Do} -> Tot config @@ -459,19 +459,19 @@ let step_projwire c = match c with //----- concatwire e1 e2 -----// let pre_econcatwire (c:config) = - is_T_exp (t_of_conf c) && is_E_concatwire (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_concatwire? (e_of_t_exp (t_of_conf c)) val step_concatwire_e1: c:config{pre_econcatwire c} -> Tot config let step_concatwire_e1 (Conf l m s en (T_exp (E_concatwire e1 e2)) tr) = Conf l m ((Frame m en (F_concatwire_e1 e2) tr)::s) en (T_exp e1) (hide []) -val step_concatwire_e2: c:config{is_value c /\ is_sframe c is_F_concatwire_e1} +val step_concatwire_e2: c:config{is_value c /\ is_sframe c F_concatwire_e1?} -> Tot config let step_concatwire_e2 (Conf l _ ((Frame m en (F_concatwire_e1 e) tr)::s) _ (T_val v) tr') = Conf l m ((Frame m en (F_concatwire_e2 v) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_concatwire_red: c:config{is_value c /\ is_sframe c is_F_concatwire_e2} +val step_concatwire_red: c:config{is_value c /\ is_sframe c F_concatwire_e2?} -> Tot config let step_concatwire_red (Conf l _ ((Frame m en (F_concatwire_e2 v1) tr)::s) _ (T_val v2) tr') = Conf l m s en (T_red (R_concatwire v1 v2)) (concat_traces tr tr') @@ -528,14 +528,14 @@ let step_concatwire c = match c with //----- ffi f l -----// let pre_effi (c:config) = - is_T_exp (t_of_conf c) && is_E_ffi (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_ffi? (e_of_t_exp (t_of_conf c)) val step_ffi_e: c:config{pre_effi c} -> Tot config let step_ffi_e (Conf l m s en (T_exp (E_ffi 'a 'b n _ fn es inj)) tr) = match es with | [] -> Conf l m s en (T_red (R_ffi n fn [] inj)) tr | e::tl -> Conf l m ((Frame m en (F_ffi n fn tl [] inj) tr)::s) en (T_exp e) (hide []) -val step_ffi_l: c:config{is_value c /\ is_sframe c is_F_ffi} -> Tot config +val step_ffi_l: c:config{is_value c /\ is_sframe c F_ffi?} -> Tot config let step_ffi_l (Conf l _ ((Frame m en (F_ffi 'a 'b n fn es vs inj) tr)::s) _ (T_val #meta v) tr') = match es with | [] -> Conf l m s en (T_red (R_ffi n fn ((D_v meta v)::vs) inj)) (concat_traces tr tr') @@ -557,13 +557,13 @@ let step_ffi (Conf l m s en (T_red (R_ffi 'a 'b n fn vs inj)) tr) = //----- if e then e1 else e2 -----// let pre_econd (c:config) = - is_T_exp (t_of_conf c) && is_E_cond (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_cond? (e_of_t_exp (t_of_conf c)) val step_cond_e: c:config{pre_econd c} -> Tot config let step_cond_e (Conf l m s en (T_exp (E_cond e e1 e2)) tr) = Conf l m ((Frame m en (F_cond e1 e2) tr)::s) en (T_exp e) (hide []) -val step_cond_red: c:config{is_value c /\ is_sframe c is_F_cond} -> Tot config +val step_cond_red: c:config{is_value c /\ is_sframe c F_cond?} -> Tot config let step_cond_red (Conf l _ ((Frame m en (F_cond e1 e2) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_cond v e1 e2)) (concat_traces tr tr') @@ -583,19 +583,19 @@ let step_cond c = match c with //----- assec e1 e2 -----// let pre_eassec (c:config) = - is_T_exp (t_of_conf c) && is_E_assec (e_of_t_exp (t_of_conf c)) + T_exp? (t_of_conf c) && E_assec? (e_of_t_exp (t_of_conf c)) val step_assec_e1: c:config{pre_eassec c} -> Tot config let step_assec_e1 (Conf l m s en (T_exp (E_assec e1 e2)) tr) = Conf l m ((Frame m en (F_assec_ps e2) tr)::s) en (T_exp e1) (hide []) -val step_assec_e2: c:config{is_value_ps c /\ is_sframe c is_F_assec_ps} +val step_assec_e2: c:config{is_value_ps c /\ is_sframe c F_assec_ps?} -> Tot config let step_assec_e2 (Conf l _ ((Frame m en (F_assec_ps e) tr)::s) _ (T_val (V_eprins ps)) tr') = Conf l m ((Frame m en (F_assec_e ps) (concat_traces tr tr'))::s) en (T_exp e) (hide []) -val step_assec_red: c:config{is_value c /\ is_sframe c is_F_assec_e} +val step_assec_red: c:config{is_value c /\ is_sframe c F_assec_e?} -> Tot config let step_assec_red (Conf l _ ((Frame m en (F_assec_e ps) tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_assec ps v)) (concat_traces tr tr') @@ -618,7 +618,7 @@ let step_assec c = match c with Conf l (Mode Sec ps) ((Frame m en' F_assec_ret tr)::s) (update_env en x V_unit) (T_exp e) (hide []) -val step_assec_ret: c:config{is_value c /\ is_sframe c is_F_assec_ret} +val step_assec_ret: c:config{is_value c /\ is_sframe c F_assec_ret?} -> Tot config let step_assec_ret (Conf l _ ((Frame m en F_assec_ret tr)::s) _ t tr') = let tr' = @@ -632,13 +632,13 @@ let step_assec_ret (Conf l _ ((Frame m en F_assec_ret tr)::s) _ t tr') = //----- mksh e -----// let pre_emksh (c:config) = - is_T_exp (t_of_conf c) && is_E_mksh (e_of_t_exp (t_of_conf c)) && is_sec c + T_exp? (t_of_conf c) && E_mksh? (e_of_t_exp (t_of_conf c)) && is_sec c val step_mksh_e: c:config{pre_emksh c} -> Tot config let step_mksh_e (Conf l m s en (T_exp (E_mksh e)) tr) = Conf l m ((Frame m en F_mksh tr)::s) en (T_exp e) (hide []) -val step_mksh_red: c:config{is_value c /\ is_sframe c is_F_mksh} -> Tot config +val step_mksh_red: c:config{is_value c /\ is_sframe c F_mksh?} -> Tot config let step_mksh_red (Conf l _ ((Frame m en F_mksh tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_mksh v)) (concat_traces tr tr') @@ -659,13 +659,13 @@ let step_mksh c = match c with //----- combsh e -----// let pre_ecombsh (c:config) = - is_T_exp (t_of_conf c) && is_E_combsh (e_of_t_exp (t_of_conf c)) && is_sec c + T_exp? (t_of_conf c) && E_combsh? (e_of_t_exp (t_of_conf c)) && is_sec c val step_combsh_e: c:config{pre_ecombsh c} -> Tot config let step_combsh_e (Conf l m s en (T_exp (E_combsh e)) tr) = Conf l m ((Frame m en F_combsh tr)::s) en (T_exp e) (hide []) -val step_combsh_red: c:config{is_value c /\ is_sframe c is_F_combsh} -> Tot config +val step_combsh_red: c:config{is_value c /\ is_sframe c F_combsh?} -> Tot config let step_combsh_red (Conf l _ ((Frame m en F_combsh tr)::s) _ (T_val v) tr') = Conf l m s en (T_red (R_combsh v)) (concat_traces tr tr') @@ -688,12 +688,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_aspar_e: - c:config{is_value_ps c /\ is_sframe c is_F_aspar_ps} + c:config{is_value_ps c /\ is_sframe c F_aspar_ps?} -> c':config{c' = step_aspar_e2 c} -> sstep c c' | C_aspar_red: - c:config{is_value c /\ is_sframe c is_F_aspar_e} + c:config{is_value c /\ is_sframe c F_aspar_e?} -> c':config{c' = step_aspar_red c} -> sstep c c' @@ -702,7 +702,7 @@ type sstep: config -> config -> Type = -> sstep c c' | C_aspar_ret: - c:config{is_sframe c is_F_aspar_ret /\ pre_aspar_ret c = Do} + c:config{is_sframe c F_aspar_ret? /\ pre_aspar_ret c = Do} -> c':config{c' = step_aspar_ret c} -> sstep c c' @@ -711,12 +711,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_box_e: - c:config{is_value_ps c /\ is_sframe c is_F_box_ps} + c:config{is_value_ps c /\ is_sframe c F_box_ps?} -> c':config{c' = step_box_e2 c} -> sstep c c' | C_box_red: - c:config{is_value c /\ is_sframe c is_F_box_e} + c:config{is_value c /\ is_sframe c F_box_e?} -> c':config{c' = step_box_red c} -> sstep c c' @@ -727,7 +727,7 @@ type sstep: config -> config -> Type = c:config{pre_eunbox c} -> c':config{c' = step_unbox_e c} -> sstep c c' | C_unbox_red: - c:config{is_value c /\ is_sframe c is_F_unbox} + c:config{is_value c /\ is_sframe c F_unbox?} -> c':config{c' = step_unbox_red c} -> sstep c c' @@ -740,12 +740,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_mkwire_e2: - c:config{is_value_ps c /\ is_sframe c is_F_mkwire_ps} + c:config{is_value_ps c /\ is_sframe c F_mkwire_ps?} -> c':config{c' = step_mkwire_e2 c} -> sstep c c' | C_mkwire_red: - c:config{is_value c /\ is_sframe c is_F_mkwire_e} + c:config{is_value c /\ is_sframe c F_mkwire_e?} -> c':config{c' = step_mkwire_red c} -> sstep c c' @@ -758,12 +758,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_projwire_e: - c:config{is_value_p c /\ is_sframe c is_F_projwire_p} + c:config{is_value_p c /\ is_sframe c F_projwire_p?} -> c':config{c' = step_projwire_e2 c} -> sstep c c' | C_projwire_red: - c:config{is_value c /\ is_sframe c is_F_projwire_e} + c:config{is_value c /\ is_sframe c F_projwire_e?} -> c':config{c' = step_projwire_red c} -> sstep c c' @@ -776,12 +776,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_concatwire_e2: - c:config{is_value c /\ is_sframe c is_F_concatwire_e1} + c:config{is_value c /\ is_sframe c F_concatwire_e1?} -> c':config{c' = step_concatwire_e2 c} -> sstep c c' | C_concatwire_red: - c:config{is_value c /\ is_sframe c is_F_concatwire_e2} + c:config{is_value c /\ is_sframe c F_concatwire_e2?} -> c':config{c' = step_concatwire_red c} -> sstep c c' @@ -802,7 +802,7 @@ type sstep: config -> config -> Type = -> sstep c c' | C_let_red: - c:config{is_value c /\ is_sframe c is_F_let} + c:config{is_value c /\ is_sframe c F_let?} -> c':config{c' = step_let_red c} -> sstep c c' @@ -826,12 +826,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_app_e2: - c:config{is_value c /\ is_sframe c is_F_app_e1} + c:config{is_value c /\ is_sframe c F_app_e1?} -> c':config{c' = step_app_e2 c} -> sstep c c' | C_app_red: - c:config{is_value c /\ is_sframe c is_F_app_e2} + c:config{is_value c /\ is_sframe c F_app_e2?} -> c':config{c' = step_app_red c} -> sstep c c' @@ -842,7 +842,7 @@ type sstep: config -> config -> Type = c:config{pre_effi c} -> c':config{c' = step_ffi_e c} -> sstep c c' | C_ffi_l: - c:config{is_value c /\ is_sframe c is_F_ffi} + c:config{is_value c /\ is_sframe c F_ffi?} -> c':config{c' = step_ffi_l c} -> sstep c c' | C_ffi_beta: @@ -852,7 +852,7 @@ type sstep: config -> config -> Type = c:config{pre_econd c} -> c':config{c' = step_cond_e c} -> sstep c c' | C_cond_red: - c:config{is_value c /\ is_sframe c is_F_cond} + c:config{is_value c /\ is_sframe c F_cond?} -> c':config{c' = step_cond_red c} -> sstep c c' @@ -864,12 +864,12 @@ type sstep: config -> config -> Type = -> sstep c c' | C_assec_e: - c:config{is_value_ps c /\ is_sframe c is_F_assec_ps} + c:config{is_value_ps c /\ is_sframe c F_assec_ps?} -> c':config{c' = step_assec_e2 c} -> sstep c c' | C_assec_red: - c:config{is_value c /\ is_sframe c is_F_assec_e} + c:config{is_value c /\ is_sframe c F_assec_e?} -> c':config{c' = step_assec_red c} -> sstep c c' @@ -878,7 +878,7 @@ type sstep: config -> config -> Type = -> sstep c c' | C_assec_ret: - c:config{is_value c /\ is_sframe c is_F_assec_ret} + c:config{is_value c /\ is_sframe c F_assec_ret?} -> c':config{c' = step_assec_ret c} -> sstep c c' @@ -886,7 +886,7 @@ type sstep: config -> config -> Type = c:config{pre_emksh c} -> c':config{c' = step_mksh_e c} -> sstep c c' | C_mksh_red: - c:config{is_value c /\ is_sframe c is_F_mksh} + c:config{is_value c /\ is_sframe c F_mksh?} -> c':config{c' = step_mksh_red c} -> sstep c c' @@ -898,7 +898,7 @@ type sstep: config -> config -> Type = c:config{pre_ecombsh c} -> c':config{c' = step_combsh_e c} -> sstep c c' | C_combsh_red: - c:config{is_value c /\ is_sframe c is_F_combsh} + c:config{is_value c /\ is_sframe c F_combsh?} -> c':config{c' = step_combsh_red c} -> sstep c c' diff --git a/examples/wysteria/theory.fst b/examples/wysteria/theory.fst index b497f9dfd86..eebd0918258 100644 --- a/examples/wysteria/theory.fst +++ b/examples/wysteria/theory.fst @@ -159,10 +159,10 @@ let env_upd_upd_slice_lemma_ps #meta1 #meta2 ps en x1 x2 v1 v2 = open FStar.Constructive val if_exit_sec_then_to_sec: #c:sconfig -> #c':config -> h:sstep c c' -> Tot bool -let if_exit_sec_then_to_sec #c #c' h = not (is_C_assec_ret h) || is_sec c' +let if_exit_sec_then_to_sec #c #c' h = not (C_assec_ret? h) || is_sec c' assume val v_opaque_meta_empty_can_b_same_slice_sps_axiom: - v:value (Meta empty Can_b empty Can_w){is_V_opaque v} -> ps:prins + v:value (Meta empty Can_b empty Can_w){V_opaque? v} -> ps:prins -> Lemma (requires (True)) (ensures (D_v.v (slice_v_sps ps v) = v)) val meta_empty_can_b_same_slice_sps: v:value (Meta empty Can_b empty Can_w) -> ps:prins @@ -518,7 +518,7 @@ let mem_intersect_not_empty_lemma_opp p ps = (* V_opaque axiom *) assume val v_opaque_slice_lem_singl_v_axiom: - #m:v_meta -> v:value m{is_V_opaque v} -> p:prin + #m:v_meta -> v:value m{V_opaque? v} -> p:prin -> Lemma (requires (True)) (ensures (slice_v p v = slice_v_sps (singleton p) v)) @@ -587,7 +587,7 @@ let boxed_wire_value_slice_lem ps1 ps2 eps w all = boxed_wire_slice_lem ps1 ps2 eps w assume val v_opaque_box_slice_lem_axiom: - #m:v_meta -> v:value m{is_V_opaque v} + #m:v_meta -> v:value m{V_opaque? v} -> ps1:prins -> ps2:prins{not (intersect ps1 ps2 = empty) /\ subset (Meta.bps m) ps2 /\ subset (Meta.wps m) ps2 /\ @@ -651,7 +651,7 @@ let slc_wire_lem_ps #eps w p ps = (* V_opaque axiom *) assume val v_opaque_slc_v_lem_ps_axiom: - #m:v_meta -> v:value m{is_V_opaque v} -> p:prin -> ps:prins{not (mem p ps)} + #m:v_meta -> v:value m{V_opaque? v} -> p:prin -> ps:prins{not (mem p ps)} -> Lemma (requires (True)) (ensures (compose_vals (D_v.v (slice_v p v)) (D_v.v (slice_v_sps ps v)) = @@ -789,10 +789,10 @@ let env_upd_upd_slice_lemma #meta1 #meta2 p en x1 x2 v1 v2 = (update_env #(D_v.meta (slice_v p v2)) (update_env #(D_v.meta (slice_v p v1)) (slice_en p en) x1 (D_v.v (slice_v p v1))) x2 (D_v.v (slice_v p v2)))) val if_enter_sec_then_from_sec: #c:sconfig -> #c':sconfig -> h:sstep c c' -> Tot bool -let if_enter_sec_then_from_sec #c #c' h = not (is_C_assec_beta h) || is_sec c +let if_enter_sec_then_from_sec #c #c' h = not (C_assec_beta? h) || is_sec c assume val v_opaque_meta_empty_can_b_same_slice_axiom: - v:value (Meta empty Can_b empty Can_w){is_V_opaque v} -> p:prin + v:value (Meta empty Can_b empty Can_w){V_opaque? v} -> p:prin -> Lemma (requires (True)) (ensures (D_v.v (slice_v p v) = v)) val meta_empty_can_b_same_slice: v:value (Meta empty Can_b empty Can_w) -> p:prin @@ -1262,26 +1262,26 @@ type pstep_par_star: #ps:prins -> protocol ps -> protocol ps -> Type = | PP_tran: #ps:prins -> #pi:protocol ps -> #pi':protocol ps -> #pi'':protocol ps - -> h:pstep #ps pi pi'{is_P_par h} -> h':pstep_par_star #ps pi' pi'' + -> h:pstep #ps pi pi'{P_par? h} -> h':pstep_par_star #ps pi' pi'' -> pstep_par_star #ps pi pi'' val update_tpar: #ps:prins -> p:prin{not (mem p ps)} - -> c:tconfig{is_Par (Mode.m (Conf.m c))} -> pi:protocol ps + -> c:tconfig{Par? (Mode.m (Conf.m c))} -> pi:protocol ps -> Tot (protocol (union (singleton p) ps)) let update_tpar #ps p c pi = update p c (fst pi), snd pi opaque val pstep_par_upd: #ps:prins -> #pi:protocol ps -> #pi':protocol ps - -> h:pstep #ps pi pi'{is_P_par h} + -> h:pstep #ps pi pi'{P_par? h} -> p:prin{not (contains p (fst pi))} - -> c:tconfig{is_Par (Mode.m (Conf.m c))} - -> Tot (r:pstep #(union (singleton p) ps) (update_tpar p c pi) (update_tpar p c pi'){is_P_par r}) + -> c:tconfig{Par? (Mode.m (Conf.m c))} + -> Tot (r:pstep #(union (singleton p) ps) (update_tpar p c pi) (update_tpar p c pi'){P_par? r}) let pstep_par_upd #ps #pi #pi' h p c = match h with | P_par #d #c' _ p' h' _ -> P_par #(union (singleton p) ps) #c' (update_tpar p c pi) p' h' (update_tpar p c pi') opaque val pstep_par_star_upd_same: #ps:prins -> #pi:protocol ps -> #pi':protocol ps -> h:pstep_par_star #ps pi pi' -> p:prin{not (contains p (fst pi))} - -> c:tconfig{is_Par (Mode.m (Conf.m c))} + -> c:tconfig{Par? (Mode.m (Conf.m c))} -> Tot (pstep_par_star #(union (singleton p) ps) (update_tpar p c pi) (update_tpar p c pi')) (decreases h) let rec pstep_par_star_upd_same #ps #pi #pi' h p c = match h with @@ -1292,8 +1292,8 @@ let rec pstep_par_star_upd_same #ps #pi #pi' h p c = match h with opaque val pstep_par_star_upd_step: #ps:prins -> #pi:protocol ps -> #pi':protocol ps - -> #c:tconfig{is_Par (Mode.m (Conf.m c))} - -> #c':tconfig{is_Par (Mode.m (Conf.m c))} + -> #c:tconfig{Par? (Mode.m (Conf.m c))} + -> #c':tconfig{Par? (Mode.m (Conf.m c))} -> h1:pstep_par_star #ps pi pi' -> h2:sstep c c' -> p:prin{not (contains p (fst pi))} -> Tot (pstep_par_star #(union (singleton p) ps) (update_tpar p c pi) (update_tpar p c' pi')) @@ -1479,14 +1479,14 @@ let slice_v_lem_singl_of_ps_forall #m v ps = forall_intro (slice_v_lem_singl_of_ps #m v ps) val sstep_sec_to_par_slice_par_others: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_ret h /\ is_par c'} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_ret? h /\ is_par c'} -> Lemma (requires (True)) (ensures (forall p. not (mem p (Mode.ps (Conf.m c))) ==> slice_c p c = slice_c p c')) let sstep_sec_to_par_slice_par_others #c #c' _ = () val sstep_sec_to_par_slice_par_mems: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_ret h /\ is_par c'} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_ret? h /\ is_par c'} -> Lemma (requires (True)) (ensures (forall p. mem p (Mode.ps (Conf.m c)) ==> ret_sec_value_to_p (slice_c_sps c) (slice_c p c) p = slice_c p c')) @@ -1549,7 +1549,7 @@ let tstep_assec_ret_cons #ps' pi ps pi' = (not (mem p ps) ==> select p (fst pi') = select p (fst pi))) ()) opaque val sstep_sec_to_par_slice_par_mems_cons: - #c:config -> #c':config -> h:sstep c c'{is_C_assec_ret h /\ is_par c'} + #c:config -> #c':config -> h:sstep c c'{C_assec_ret? h /\ is_par c'} -> ps':prins{ps' = Mode.ps (Conf.m c)} -> sec_c:tconfig{sec_c = slice_c_sps c} -> Tot (p:prin -> Tot (mem p ps' ==> ret_sec_value_to_p sec_c (slice_c p c) p = slice_c p c')) let sstep_sec_to_par_slice_par_mems_cons #c #c' h ps' sec_c = @@ -1558,7 +1558,7 @@ let sstep_sec_to_par_slice_par_mems_cons #c #c' h ps' sec_c = #(t_intro #(forall p. (mem p ps' ==> ret_sec_value_to_p sec_c (slice_c p c) p = slice_c p c')) ()) opaque val sstep_sec_to_par_slice_par_others_cons: - #c:config -> #c':config -> h:sstep c c'{is_C_assec_ret h /\ is_par c'} + #c:config -> #c':config -> h:sstep c c'{C_assec_ret? h /\ is_par c'} -> ps':prins{ps' = Mode.ps (Conf.m c)} -> Tot (p:prin -> Tot (not (mem p ps') ==> slice_c p c = slice_c p c')) let sstep_sec_to_par_slice_par_others_cons #c #c' h ps' = @@ -1567,7 +1567,7 @@ let sstep_sec_to_par_slice_par_others_cons #c #c' h ps' = #(t_intro #(forall p. (not (mem p ps') ==> slice_c p c = slice_c p c')) ())*) opaque val forward_simulation_exit_sec: #c:sconfig -> #c':sconfig - -> h:sstep c c'{is_C_assec_ret h /\ is_par c'} + -> h:sstep c c'{C_assec_ret? h /\ is_par c'} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> Tot (pstep #ps (slice_c_ps ps c) (slice_c_ps ps c')) let forward_simulation_exit_sec #c #c' h ps = @@ -1623,7 +1623,7 @@ let forward_simulation_exit_sec #c #c' h ps = let f7: p:prin -> q1:(b2t (mem p ps)) -> q2:(b2t (mem p ps')) -> Tot (b2t (select p pi_s = select p pi')) = fun p q1 q2 -> - let _ = admitP (b2t (is_Some (select p pi))) in + let _ = admitP (b2t (Some? (select p pi))) in let k1 = cand_intro (f3 p) in let Conj k2 k3 = k1 in let k4:(b2t (select p pi_s = Some (ret_sec_value_to_p (Some.v s) (Some.v (select p pi)) p))) = (imp_intro k2) q2 in @@ -1724,21 +1724,21 @@ let forward_simulation_exit_sec #c #c' h ps = P_sec_exit #ps (pi, s) ps' (pi_s, s_s) opaque val sstep_par_to_sec_slice_par_others: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> Lemma (requires (True)) (ensures (forall p. not (mem p (Mode.ps (Conf.m c))) ==> slice_c p c = slice_c p c')) let sstep_par_to_sec_slice_par_others #c #c' h = () opaque val sstep_par_to_sec_slice_par_mems: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> Lemma (requires (True)) (ensures (forall p. mem p (Mode.ps (Conf.m c)) ==> step_p_to_wait (slice_c p c) p = slice_c p c')) let sstep_par_to_sec_slice_par_mems #c #c' h = () opaque val sstep_par_to_sec_slice_par: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> x:varname -> e:exp{tpre_assec #ps (slice_c_ps ps c) (Mode.ps (Conf.m c)) x e} -> Lemma (requires (True)) @@ -1783,7 +1783,7 @@ opaque val slice_clos_lem: #meta:v_meta -> v:value meta{is_clos v} let slice_clos_lem #meta v = () opaque val sstep_par_to_sec_en_compose_lemma: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> Lemma (requires (True)) (ensures (forall p. mem p (Mode.ps (Conf.m c)) ==> @@ -1795,7 +1795,7 @@ let sstep_par_to_sec_en_compose_lemma #c #c' h ps = #reset-options "--z3timeout 20" opaque val forward_simulation_enter_sec: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> Tot (pstep #ps (slice_c_ps ps c) (slice_c_ps ps c')) let forward_simulation_enter_sec #c #c' h ps = @@ -1932,7 +1932,7 @@ type strong_confluence (ps:prins) (pi:protocol ps) (pi1:protocol ps) opaque val pstep_ppar_ppar_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_par h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_par? h2} -> Tot (cor (u:unit{pi1 = pi2 /\ h1 = h2}) (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 @@ -1962,7 +1962,7 @@ opaque val pstep_ppar_ppar_confluence: opaque val pstep_ppar_psec_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_sec h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_sec? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -1991,23 +1991,23 @@ let step_ps_to_wait_update_lemma ps' pi ps p c = () val target_par_sstep_lemma: c:tconfig_par -> c':tconfig_par -> h:sstep c c' -> Lemma (requires (True)) - (ensures ((not (is_T_red (Conf.t c) && is_R_assec (T_red.r (Conf.t c)))) /\ - (not (is_T_sec_wait (Conf.t c))))) + (ensures ((not (T_red? (Conf.t c) && R_assec? (T_red.r (Conf.t c)))) /\ + (not (T_sec_wait? (Conf.t c))))) let target_par_sstep_lemma c c' h = () val pstep_ppar_psec_enter_excl_lemma: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_sec_enter h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_sec_enter? h2} -> Lemma (requires (True)) (ensures (not (mem (P_par.p h1) (P_sec_enter.ps h2)))) let pstep_ppar_psec_enter_excl_lemma #ps pi pi1 pi2 h1 h2 = - let _ = cut (forall p. mem p (P_sec_enter.ps h2) ==> (is_T_red (Conf.t (Some.v (select p (fst pi)))) /\ - is_R_assec (T_red.r (Conf.t (Some.v (select p (fst pi))))))) in + let _ = cut (forall p. mem p (P_sec_enter.ps h2) ==> (T_red? (Conf.t (Some.v (select p (fst pi)))) /\ + R_assec? (T_red.r (Conf.t (Some.v (select p (fst pi))))))) in target_par_sstep_lemma (Some.v (select (P_par.p h1) (fst pi))) (P_par.c' h1) (P_par.h h1) opaque val pstep_ppar_psec_enter_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_sec_enter h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_sec_enter? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -2047,16 +2047,16 @@ let ret_sec_value_to_ps_update_lemma ps' pi sec_c ps p c = () val pstep_ppar_psec_exit_excl_lemma: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Lemma (requires (True)) (ensures (not (mem (P_par.p h1) (P_sec_exit.ps h2)))) let pstep_ppar_psec_exit_excl_lemma #ps pi pi1 pi2 h1 h2 = - let _ = cut (forall p. mem p (P_sec_exit.ps h2) ==> (is_T_sec_wait (Conf.t (Some.v (select p (fst pi)))))) in + let _ = cut (forall p. mem p (P_sec_exit.ps h2) ==> (T_sec_wait? (Conf.t (Some.v (select p (fst pi)))))) in target_par_sstep_lemma (Some.v (select (P_par.p h1) (fst pi))) (P_par.c' h1) (P_par.h h1) opaque val pstep_ppar_psec_exit_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_par h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_par? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -2081,7 +2081,7 @@ let pstep_ppar_psec_exit_confluence #ps pi pi1 pi2 h1 h2 = opaque val pstep_psec_psec_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec h1} -> h2:pstep #ps pi pi2{is_P_sec h2} + -> h1:pstep #ps pi pi1{P_sec? h1} -> h2:pstep #ps pi pi2{P_sec? h2} -> Tot (cor (u:unit{pi1 = pi2 /\ h1 = h2}) (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 @@ -2103,7 +2103,7 @@ let pstep_psec_psec_confluence #ps pi pi1 pi2 h1 h2 = opaque val pstep_psec_psec_enter_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec h1} -> h2:pstep #ps pi pi2{is_P_sec_enter h2} + -> h1:pstep #ps pi pi1{P_sec? h1} -> h2:pstep #ps pi pi2{P_sec_enter? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -2154,14 +2154,14 @@ let pstep_psec_psec_enter_confluence #ps pi pi1 pi2 h1 h2 = val pstep_psec_psec_exit_excl_lemma: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_sec? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Lemma (requires (True)) (ensures (not (P_sec.ps h1 = P_sec_exit.ps h2))) let pstep_psec_psec_exit_excl_lemma #ps pi pi1 pi2 h1 h2 = () // TODO: FIXME: make it faster ? opaque val pstep_psec_psec_exit_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_sec? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -2189,7 +2189,7 @@ let pstep_psec_psec_exit_confluence #ps pi pi1 pi2 h1 h2 = val pstep_psec_enter_psec_enter_empty_intersection: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec_enter h1} -> h2:pstep #ps pi pi2{is_P_sec_enter h2 /\ not (P_sec_enter.ps h1 = P_sec_enter.ps h2)} + -> h1:pstep #ps pi pi1{P_sec_enter? h1} -> h2:pstep #ps pi pi2{P_sec_enter? h2 /\ not (P_sec_enter.ps h1 = P_sec_enter.ps h2)} -> Lemma (requires (True)) (ensures (Equal (intersect (P_sec_enter.ps h1) (P_sec_enter.ps h2)) empty)) let pstep_psec_enter_psec_enter_empty_intersection #ps pi pi1 pi2 h1 h2 = () @@ -2203,7 +2203,7 @@ let empty_intersect_mem_disjoint_lemma ps1 ps2 = () opaque val pstep_psec_enter_psec_enter_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec_enter h1} -> h2:pstep #ps pi pi2{is_P_sec_enter h2} + -> h1:pstep #ps pi pi1{P_sec_enter? h1} -> h2:pstep #ps pi pi2{P_sec_enter? h2} -> Tot (cor (u:unit{pi1 = pi2 /\ h1 = h2}) (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 @@ -2268,7 +2268,7 @@ let pstep_psec_enter_psec_enter_confluence #ps pi pi1 pi2 h1 h2 = opaque val pstep_psec_enter_psec_exit_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec_enter h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_sec_enter? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Tot (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c}))) @@ -2329,7 +2329,7 @@ let pstep_psec_exit_psec_exit_helper_lemma ps1 ps2 = opaque val pstep_psec_exit_psec_exit_confluence: #ps:prins -> pi:protocol ps -> pi1:protocol ps -> pi2:protocol ps - -> h1:pstep #ps pi pi1{is_P_sec_exit h1} -> h2:pstep #ps pi pi2{is_P_sec_exit h2} + -> h1:pstep #ps pi pi1{P_sec_exit? h1} -> h2:pstep #ps pi pi2{P_sec_exit? h2} -> Tot (cor (u:unit{pi1 = pi2 /\ h1 = h2}) (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 @@ -2376,14 +2376,14 @@ opaque val pstep_confluence_theorem: (cexists #(protocol ps) (fun pi3 -> (c:cand (pstep #ps pi1 pi3) (pstep #ps pi2 pi3){strong_confluence ps pi pi1 pi2 pi3 h1 h2 c})))) let pstep_confluence_theorem ps pi pi1 pi2 h1 h2 = - if is_P_par h1 then - if is_P_par h2 then pstep_ppar_ppar_confluence #ps pi pi1 pi2 h1 h2 - else if is_P_sec h2 then IntroR (pstep_ppar_psec_confluence #ps pi pi1 pi2 h1 h2) - else if is_P_sec_enter h2 then IntroR (pstep_ppar_psec_enter_confluence #ps pi pi1 pi2 h1 h2) + if P_par? h1 then + if P_par? h2 then pstep_ppar_ppar_confluence #ps pi pi1 pi2 h1 h2 + else if P_sec? h2 then IntroR (pstep_ppar_psec_confluence #ps pi pi1 pi2 h1 h2) + else if P_sec_enter? h2 then IntroR (pstep_ppar_psec_enter_confluence #ps pi pi1 pi2 h1 h2) else IntroR (pstep_ppar_psec_exit_confluence #ps pi pi1 pi2 h1 h2) - else if is_P_sec h1 then - if is_P_par h2 then + else if P_sec? h1 then + if P_par? h2 then let p = pstep_ppar_psec_confluence #ps pi pi2 pi1 h2 h1 in let ExIntro pi3 (Conj p2 p1) = p in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in @@ -2391,50 +2391,50 @@ let pstep_confluence_theorem ps pi pi1 pi2 h1 h2 = let _ = cut (b2t (Conj.h2 (Conj p2 p1) = Conj.h1 (Conj p1 p2))) in let _ = assert (strong_confluence ps pi pi1 pi2 pi3 h1 h2 (Conj p1 p2)) in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec h2 then pstep_psec_psec_confluence #ps pi pi1 pi2 h1 h2 - else if is_P_sec_enter h2 then + else if P_sec? h2 then pstep_psec_psec_confluence #ps pi pi1 pi2 h1 h2 + else if P_sec_enter? h2 then let ExIntro pi3 (Conj p1 p2) = pstep_psec_psec_enter_confluence #ps pi pi1 pi2 h1 h2 in IntroR (ExIntro pi3 (Conj p1 p2)) else let ExIntro pi3 (Conj p1 p2) = pstep_psec_psec_exit_confluence #ps pi pi1 pi2 h1 h2 in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec_enter h1 then - if is_P_par h2 then + else if P_sec_enter? h1 then + if P_par? h2 then let ExIntro pi3 (Conj p2 p1) = pstep_ppar_psec_enter_confluence #ps pi pi2 pi1 h2 h1 in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in let _ = cut (b2t (Conj.h1 (Conj p2 p1) = Conj.h2 (Conj p1 p2))) in let _ = cut (b2t (Conj.h2 (Conj p2 p1) = Conj.h1 (Conj p1 p2))) in let _ = assert (strong_confluence ps pi pi1 pi2 pi3 h1 h2 (Conj p1 p2)) in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec h2 then + else if P_sec? h2 then let ExIntro pi3 (Conj p2 p1) = pstep_psec_psec_enter_confluence #ps pi pi2 pi1 h2 h1 in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in let _ = cut (b2t (Conj.h1 (Conj p2 p1) = Conj.h2 (Conj p1 p2))) in let _ = cut (b2t (Conj.h2 (Conj p2 p1) = Conj.h1 (Conj p1 p2))) in let _ = assert (strong_confluence ps pi pi1 pi2 pi3 h1 h2 (Conj p1 p2)) in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec_enter h2 then pstep_psec_enter_psec_enter_confluence #ps pi pi1 pi2 h1 h2 + else if P_sec_enter? h2 then pstep_psec_enter_psec_enter_confluence #ps pi pi1 pi2 h1 h2 else let ExIntro pi3 (Conj p1 p2) = pstep_psec_enter_psec_exit_confluence #ps pi pi1 pi2 h1 h2 in IntroR (ExIntro pi3 (Conj p1 p2)) else - if is_P_par h2 then + if P_par? h2 then let ExIntro pi3 (Conj p2 p1) = pstep_ppar_psec_exit_confluence #ps pi pi2 pi1 h2 h1 in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in let _ = cut (b2t (Conj.h1 (Conj p2 p1) = Conj.h2 (Conj p1 p2))) in let _ = cut (b2t (Conj.h2 (Conj p2 p1) = Conj.h1 (Conj p1 p2))) in let _ = assert (strong_confluence ps pi pi1 pi2 pi3 h1 h2 (Conj p1 p2)) in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec h2 then + else if P_sec? h2 then let ExIntro pi3 (Conj p2 p1) = pstep_psec_psec_exit_confluence #ps pi pi2 pi1 h2 h1 in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in let _ = cut (b2t (Conj.h1 (Conj p2 p1) = Conj.h2 (Conj p1 p2))) in let _ = cut (b2t (Conj.h2 (Conj p2 p1) = Conj.h1 (Conj p1 p2))) in let _ = assert (strong_confluence ps pi pi1 pi2 pi3 h1 h2 (Conj p1 p2)) in IntroR (ExIntro pi3 (Conj p1 p2)) - else if is_P_sec_enter h2 then + else if P_sec_enter? h2 then let ExIntro pi3 (Conj p2 p1) = pstep_psec_enter_psec_exit_confluence #ps pi pi2 pi1 h2 h1 in let _ = cut (strong_confluence ps pi pi2 pi1 pi3 h2 h1 (Conj p2 p1)) in @@ -2715,7 +2715,7 @@ assume V_cmp_is_total_order: total_order varname v_cmp type env_dom = ordset varname v_cmp -assume val dom_of_env: en:env -> GTot (s:env_dom{forall x. mem x s = is_Some (en x)}) +assume val dom_of_env: en:env -> GTot (s:env_dom{forall x. mem x s = Some? (en x)}) val subdomain: env_dom -> env -> GTot bool let subdomain s en = subset s (dom_of_env en) @@ -2782,8 +2782,8 @@ let rec composable_envs_on_lemma en1 en2 s = val composable_envs_lemma: en1:env -> en2:env{composable_envs en1 en2} - -> GTot (u:unit{forall x. is_Some (en1 x) = is_Some (en2 x) /\ - (is_Some (en1 x) ==> + -> GTot (u:unit{forall x. Some? (en1 x) = Some? (en2 x) /\ + (Some? (en1 x) ==> composable_vals (Some.v (en1 x)) (Some.v (en2 x)))}) let composable_envs_lemma en1 en2 = composable_envs_on_lemma en1 en2 (dom_of_env en1) @@ -2968,7 +2968,7 @@ assume val slice_p_p_composable_envs_lemma: composable_envs (slice_en p1 en) (slice_en p2 en))) type r_assec_c (c:config) = - is_T_red (Conf.t c) /\ is_R_assec (T_red.r (Conf.t c)) /\ + T_red? (Conf.t c) /\ R_assec? (T_red.r (Conf.t c)) /\ is_clos (R_assec.v (T_red.r (Conf.t c))) val conf_of_p: ps:prins -> pi:protocol ps -> p:prin{contains p (fst pi)} -> Tot tconfig_par @@ -2978,7 +2978,7 @@ val en_of_r_assec: c:config{r_assec_c c} -> Tot env let en_of_r_assec c = MkTuple3._1 (get_en_b (R_assec.v (T_red.r (Conf.t c)))) val enter_sec_from_par_composable_env_map_helper: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> pi:protocol ps{pi = slice_c_ps ps c} -> en:env{en = MkTuple3._1 (get_en_b (R_assec.v (T_red.r (Conf.t c))))} @@ -2990,7 +2990,7 @@ val enter_sec_from_par_composable_env_map_helper: let enter_sec_from_par_composable_env_map_helper #c #c' h ps pi en = () type enter_sec_composable (c:sconfig) (c':sconfig) - (h:sstep c c'{is_C_assec_beta h /\ is_par c}) + (h:sstep c c'{C_assec_beta? h /\ is_par c}) (ps:prins{subset (Mode.ps (Conf.m c)) ps}) (ps':prins{ps' = Mode.ps (Conf.m c)}) = (forall p. mem p ps' ==> r_assec_c (conf_of_p ps (slice_c_ps ps c) p)) /\ @@ -2999,7 +2999,7 @@ type enter_sec_composable (c:sconfig) (c':sconfig) (en_of_r_assec (conf_of_p ps (slice_c_ps ps c) p2))) val enter_sec_from_par_composable_env_map_lemma: - #c:sconfig -> #c':sconfig -> h:sstep c c'{is_C_assec_beta h /\ is_par c} + #c:sconfig -> #c':sconfig -> h:sstep c c'{C_assec_beta? h /\ is_par c} -> ps:prins{subset (Mode.ps (Conf.m c)) ps} -> GTot (u:unit{enter_sec_composable c c' h ps (Mode.ps (Conf.m c))}) let enter_sec_from_par_composable_env_map_lemma #c #c' h ps = @@ -3013,9 +3013,9 @@ let enter_sec_from_par_composable_env_map_lemma #c #c' h ps = val composable_compose_lemma: dv1:dvalue -> dv2:dvalue{composable_vals dv1 dv2} -> Lemma (requires (True)) - (ensures (is_V_emp (D_v.v (compose_vals #(D_v.meta dv1) #(D_v.meta dv2) + (ensures (V_emp? (D_v.v (compose_vals #(D_v.meta dv1) #(D_v.meta dv2) (D_v.v dv1) (D_v.v dv2))) <==> - (is_V_emp (D_v.v dv1) /\ is_V_emp (D_v.v dv2)))) + (V_emp? (D_v.v dv1) /\ V_emp? (D_v.v dv2)))) let composable_compose_lemma dv1 dv2 = () (* ********) diff --git a/examples/wysteria/universes/ast.fst b/examples/wysteria/universes/ast.fst index c31bf74cd65..faa10a6f8de 100644 --- a/examples/wysteria/universes/ast.fst +++ b/examples/wysteria/universes/ast.fst @@ -206,24 +206,24 @@ type term = type level = | Source | Target val src: level -> Tot bool -let src l = is_Source l +let src l = Source? l (* TODO: FIXME: workaround for projectors *) val m_of_mode: mode -> Tot as_mode let m_of_mode (Mode m _) = m type mode_inv (m:mode) (l:level) = - (is_Target l /\ m_of_mode m = Par) ==> (size (Mode.ps m) = 1) + (Target? l /\ m_of_mode m = Par) ==> (size (Mode.ps m) = 1) val is_sec_frame: f':frame' -> Tot bool let is_sec_frame f' = - not (is_F_aspar_ps f' || is_F_aspar_e f' || is_F_aspar_ret f') + not (F_aspar_ps? f' || F_aspar_e? f' || F_aspar_ret? f') val is_par_frame: f':frame' -> Tot bool -let is_par_frame f' = not (is_F_mksh f' || is_F_combsh f') +let is_par_frame f' = not (F_mksh? f' || F_combsh? f') (* TODO: FIXME: workaround for projectors *) -val ps_of_aspar_ret_frame: f':frame'{is_F_aspar_ret f'} -> Tot prins +val ps_of_aspar_ret_frame: f':frame'{F_aspar_ret? f'} -> Tot prins let ps_of_aspar_ret_frame (F_aspar_ret ps) = ps val stack_source_inv: stack -> mode -> GTot bool @@ -232,12 +232,12 @@ let rec stack_source_inv s (Mode as_m ps) = match s with | (Frame m' _ f' tr)::tl -> let Mode as_m' ps' = m' in (not (as_m = Par) || as_m' = Par) && - (not (as_m = Par) || not (is_F_assec_ret f')) && - (not (as_m = Sec) || (not (as_m' = Par) || is_F_assec_ret f')) && - (not (as_m' = Sec) || (is_sec_frame f' && is_Cons tl)) && + (not (as_m = Par) || not (F_assec_ret? f')) && + (not (as_m = Sec) || (not (as_m' = Par) || F_assec_ret? f')) && + (not (as_m' = Sec) || (is_sec_frame f' && Cons? tl)) && (not (as_m' = Sec) || (vals_trace tr)) && - (not (is_F_aspar_ret f') || (ps = ps_of_aspar_ret_frame f')) && - (ps = ps' || (subset ps ps' && is_F_aspar_ret f')) && + (not (F_aspar_ret? f') || (ps = ps_of_aspar_ret_frame f')) && + (ps = ps' || (subset ps ps' && F_aspar_ret? f')) && (not (as_m = Par) || is_par_frame f') && stack_source_inv tl m' @@ -253,23 +253,23 @@ let rec stack_target_inv s m = match s with val stack_inv: stack -> mode -> level -> GTot bool let rec stack_inv s m l = - if is_Source l then stack_source_inv s m else stack_target_inv s m + if Source? l then stack_source_inv s m else stack_target_inv s m val is_sec_redex: redex -> Tot bool -let is_sec_redex r = not (is_R_aspar r) //|| is_R_box r) +let is_sec_redex r = not (R_aspar? r) //|| R_box? r) val is_par_redex: redex -> Tot bool -let is_par_redex r = not (is_R_mksh r || is_R_combsh r) //|| is_R_box r) +let is_par_redex r = not (R_mksh? r || R_combsh? r) //|| R_box? r) (* TODO: FIXME: workaround for projectors *) -val r_of_t_red: t:term{is_T_red t} -> Tot redex +val r_of_t_red: t:term{T_red? t} -> Tot redex let r_of_t_red (T_red r) = r val term_inv: term -> mode -> level -> Tot bool let term_inv t m l = - (not (is_Source l) || not (t = T_sec_wait)) && - (not (is_T_red t && m_of_mode m = Sec) || is_sec_redex (r_of_t_red t)) && - (not (is_T_red t && m_of_mode m = Par) || is_par_redex (r_of_t_red t)) + (not (Source? l) || not (t = T_sec_wait)) && + (not (T_red? t && m_of_mode m = Sec) || is_sec_redex (r_of_t_red t)) && + (not (T_red? t && m_of_mode m = Par) || is_par_redex (r_of_t_red t)) val trace_inv: erased trace -> mode -> GTot bool let trace_inv tr m = not (m_of_mode m = Sec) || (vals_trace tr) @@ -279,26 +279,26 @@ type config = -> en:env -> t:term{term_inv t m l} -> tr:erased trace{trace_inv tr m} -> config -type sconfig = c:config{is_Source (Conf.l c)} -type tconfig = c:config{is_Target (Conf.l c)} +type sconfig = c:config{Source? (Conf.l c)} +type tconfig = c:config{Target? (Conf.l c)} (* TODO: FIXME: workaround for projectors *) val f_of_frame: frame -> Tot frame' let f_of_frame (Frame _ _ f _) = f (* TODO: FIXME: workaround for projectors *) -val hd_of_list: l:list 'a{is_Cons l} -> Tot 'a +val hd_of_list: l:list 'a{Cons? l} -> Tot 'a let hd_of_list (Cons hd _) = hd val is_sframe: c:config -> f:(frame' -> Tot bool) -> Tot bool -let is_sframe (Conf _ _ s _ _ _) f = is_Cons s && f (f_of_frame (hd_of_list s)) +let is_sframe (Conf _ _ s _ _ _) f = Cons? s && f (f_of_frame (hd_of_list s)) (* TODO: FIXME: workaround for projectors *) val t_of_conf: config -> Tot term let t_of_conf (Conf _ _ _ _ t _) = t val is_value: c:config -> Tot bool -let is_value c = is_T_val (t_of_conf c) +let is_value c = T_val? (t_of_conf c) val is_value_ps: c:config -> Tot bool let is_value_ps c = match c with @@ -326,14 +326,14 @@ val m_of_conf: config-> Tot mode let m_of_conf (Conf _ m _ _ _ _) = m val is_par: config -> Tot bool -let is_par c = is_Par (m_of_mode (m_of_conf c)) +let is_par c = Par? (m_of_mode (m_of_conf c)) val is_sec: config -> Tot bool -let is_sec c = is_Sec (m_of_mode (m_of_conf c)) +let is_sec c = Sec? (m_of_mode (m_of_conf c)) (* TODO: FIXME: the discriminators should take extra args for type indices *) val is_clos: #meta:v_meta -> value meta -> Tot bool -let is_clos #meta v = match v with//is_V_clos v || is_V_fix_clos v || is_V_emp_clos v +let is_clos #meta v = match v with//V_clos? v || V_fix_clos? v || V_emp_clos? v | V_clos _ _ _ | V_emp_clos _ _ | V_fix_clos _ _ _ _ -> true @@ -347,10 +347,10 @@ let get_en_b #meta v = match v with | V_emp_clos x e -> empty_env, x, e val is_terminal: config -> Tot bool -let is_terminal (Conf _ (Mode as_m _) s _ t _) = as_m = Par && s = [] && is_T_val t +let is_terminal (Conf _ (Mode as_m _) s _ t _) = as_m = Par && s = [] && T_val? t val is_sterminal: config -> Tot bool -let is_sterminal (Conf _ _ s _ t _) = s = [] && is_T_val t +let is_sterminal (Conf _ _ s _ t _) = s = [] && T_val? t //-----// diff --git a/lib/FStar.All.fst b/lib/FStar.All.fst index 4b82eb35505..2ac5bc79ed6 100644 --- a/lib/FStar.All.fst +++ b/lib/FStar.All.fst @@ -35,7 +35,7 @@ sub_effect assume val pipe_right: 'a -> ('a -> 'b) -> 'b assume val pipe_left: ('a -> 'b) -> 'a -> 'b -assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> is_Err a /\ h==h') +assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h') assume val exit: int -> 'a assume val try_with: (unit -> 'a) -> (exn -> 'a) -> 'a assume val op_Less_Less : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c diff --git a/lib/FStar.Axiomatic.Array.fst b/lib/FStar.Axiomatic.Array.fst index c39de4d6795..60b5e5419e5 100644 --- a/lib/FStar.Axiomatic.Array.fst +++ b/lib/FStar.Axiomatic.Array.fst @@ -90,5 +90,5 @@ assume EmpConst: forall (a:Type) (s:seq a).{:pattern (length s)} length s == 0 ==> s==emp a -type IsSomeAll (a:Type) (s:seq (option a)) = (forall (i:int). (0 <= i /\ i < length s) ==> is_Some (index s i)) +type IsSomeAll (a:Type) (s:seq (option a)) = (forall (i:int). (0 <= i /\ i < length s) ==> Some? (index s i)) diff --git a/lib/FStar.HyperHeap.fst b/lib/FStar.HyperHeap.fst index 8cc3c462ad1..644ef8c0404 100644 --- a/lib/FStar.HyperHeap.fst +++ b/lib/FStar.HyperHeap.fst @@ -73,7 +73,7 @@ let rec lemma_disjoint_includes i j k = else ())) val extends: rid -> rid -> Tot bool -let extends r0 r1 = is_Cons r0 && Cons.tl r0 = r1 +let extends r0 r1 = Cons? r0 && Cons.tl r0 = r1 val parent: r:rid{r<>root} -> Tot rid let parent r = Cons.tl r diff --git a/lib/FStar.List.Tot.fst b/lib/FStar.List.Tot.fst index e8949dd3452..31a525211ce 100644 --- a/lib/FStar.List.Tot.fst +++ b/lib/FStar.List.Tot.fst @@ -25,11 +25,11 @@ module FStar.List.Tot val isEmpty: list 'a -> Tot bool let isEmpty l = match l with | [] -> true | _ -> false -val hd: l:list 'a{is_Cons l} -> Tot 'a +val hd: l:list 'a{Cons? l} -> Tot 'a let hd = function | hd::_ -> hd -val tl: l:list 'a {is_Cons l} -> Tot (list 'a) +val tl: l:list 'a {Cons? l} -> Tot (list 'a) let tl = function | _::tl -> tl diff --git a/lib/FStar.OrdMap.fst b/lib/FStar.OrdMap.fst index f28d33e99ad..3ca5f2af698 100644 --- a/lib/FStar.OrdMap.fst +++ b/lib/FStar.OrdMap.fst @@ -10,7 +10,7 @@ opaque type total_order (a:Type) (f: (a -> a -> Tot bool)) = type cmp (a:Type) = f:(a -> a -> Tot bool){total_order a f} private type map_t (k:Type) (v:Type) (f:cmp k) (d:ordset k f) = - g:(k -> Tot (option v)){(forall x. (mem #k #f x d = is_Some (g x)))} + g:(k -> Tot (option v)){(forall x. (mem #k #f x d = Some? (g x)))} abstract type ordmap: key:Type -> value:Type -> cmp key -> Type = | Mk_map: #k:Type -> #v:Type -> #f:cmp k -> d:ordset k f -> m:map_t k v f d -> ordmap k v f @@ -131,7 +131,7 @@ let sel_empty (#k:Type) (#v:Type) #f x = () abstract val sel_contains: #k:Type -> #v:Type -> #f:cmp k -> x:k -> m:ordmap k v f -> Lemma (requires (True)) - (ensures (contains #k #v #f x m = is_Some (select #k #v #f x m))) + (ensures (contains #k #v #f x m = Some? (select #k #v #f x m))) [SMTPat (select #k #v #f x m); SMTPat (contains #k #v #f x m)] let sel_contains (#k:Type) (#v:Type) #f x m = () @@ -176,7 +176,7 @@ let eq_remove (#k:Type) (#v:Type) #f x m = () abstract val choose_empty: #k:Type -> #v:Type -> #f:cmp k - -> Lemma (requires True) (ensures (is_None (choose #k #v #f + -> Lemma (requires True) (ensures (None? (choose #k #v #f (empty #k #v #f)))) [SMTPat (choose #k #v #f (empty #k #v #f))] let choose_empty (#k:Type) (#v:Type) #f = () @@ -194,7 +194,7 @@ let dom_empty_helper (#k:Type) (#v:Type) #f m = abstract val choose_m: #k:Type -> #v:Type -> #f:cmp k -> m:ordmap k v f -> Lemma (requires (~ (Equal m (empty #k #v #f)))) - (ensures (is_Some (choose #k #v #f m) /\ + (ensures (Some? (choose #k #v #f m) /\ (select #k #v #f (fst (Some.v (choose #k #v #f m))) m = Some (snd (Some.v (choose #k #v #f m)))) /\ (Equal m (update #k #v #f (fst (Some.v (choose #k #v #f m))) diff --git a/lib/FStar.OrdSet.fst b/lib/FStar.OrdSet.fst index e76f08dc858..a645ceead57 100644 --- a/lib/FStar.OrdSet.fst +++ b/lib/FStar.OrdSet.fst @@ -19,14 +19,14 @@ abstract val mem: #a:Type -> #f:cmp a -> a -> s:ordset a f -> Tot bool let mem (#a:Type) #f x s = FStar.List.Tot.mem x s private val set_props: - #a:Type -> #f:cmp a -> s:ordset a f{is_Cons s} + #a:Type -> #f:cmp a -> s:ordset a f{Cons? s} -> Lemma (requires (True)) (ensures (forall x. mem #a #f x (Cons.tl s) ==> (f (Cons.hd s) x /\ Cons.hd s =!= x))) let rec set_props (#a:Type) #f s = match s with | x::tl -> if tl = [] then () else set_props #a #f tl -private val hd_unique: #a:Type -> #f:cmp a -> s:ordset a f{is_Cons s} - -> Lemma (requires (is_Cons s)) +private val hd_unique: #a:Type -> #f:cmp a -> s:ordset a f{Cons? s} + -> Lemma (requires (Cons? s)) (ensures (not (mem #a #f (Cons.hd s) (Cons.tl s)))) let hd_unique (#a:Type) #f s = set_props #a #f s @@ -34,9 +34,9 @@ abstract val empty: #a:Type -> #f:cmp a -> Tot (ordset a f) let empty (#a:Type) #f = [] private val insert': #a:Type -> #f:cmp a -> x:a -> s:ordset a f - -> Tot (l:(ordset a f){is_Cons l /\ + -> Tot (l:(ordset a f){Cons? l /\ (Cons.hd l = x \/ - (is_Cons s /\ Cons.hd l = Cons.hd s))}) + (Cons? s /\ Cons.hd l = Cons.hd s))}) let rec insert' (#a:Type) #f x s = match s with | [] -> [x] | hd::tl -> @@ -64,9 +64,9 @@ let choose (#a:Type) #f s = match s with | x::_ -> Some x private val remove': #a:Type -> #f:cmp a -> x:a -> s:ordset a f - -> Tot (l:(ordset a f){(is_Nil s ==> is_Nil l) /\ - (is_Cons s ==> Cons.hd s = x ==> l = Cons.tl s) /\ - (is_Cons s ==> Cons.hd s =!= x ==> (is_Cons l /\ Cons.hd l = Cons.hd s))}) + -> Tot (l:(ordset a f){(Nil? s ==> Nil? l) /\ + (Cons? s ==> Cons.hd s = x ==> l = Cons.tl s) /\ + (Cons? s ==> Cons.hd s =!= x ==> (Cons? l /\ Cons.hd l = Cons.hd s))}) let rec remove' (#a:Type) #f x s = match s with | [] -> [] | hd::tl -> @@ -95,7 +95,7 @@ opaque type Equal (#a:Type) (#f:cmp a) (s1:ordset a f) (s2:ordset a f) = (forall x. mem #_ #f x s1 = mem #_ #f x s2) private abstract val eq_helper: #a:Type -> #f:cmp a -> x:a -> s:ordset a f - -> Lemma (requires (is_Cons s /\ f x (Cons.hd s) /\ x =!= Cons.hd s)) + -> Lemma (requires (Cons? s /\ f x (Cons.hd s) /\ x =!= Cons.hd s)) (ensures (not (mem #a #f x s))) let eq_helper (#a:Type) #f x (y::s) = set_props #a #f (y::s) @@ -198,13 +198,13 @@ let mem_subset (#a:Type) #f s1 s2 = subset_implies_mem #a #f s1 s2; mem_implies_subset #a #f s1 s2 abstract val choose_empty: #a:Type -> #f:cmp a - -> Lemma (requires True) (ensures (is_None (choose #a #f (empty #a #f)))) + -> Lemma (requires True) (ensures (None? (choose #a #f (empty #a #f)))) [SMTPat (choose #a #f (empty #a #f))] let choose_empty (#a:Type) #f = () abstract val choose_s: #a:Type -> #f:cmp a -> s:ordset a f -> Lemma (requires (not (s = (empty #a #f)))) - (ensures (is_Some (choose #a #f s) /\ + (ensures (Some? (choose #a #f s) /\ s = union #a #f (singleton #a #f (Some.v (choose #a #f s))) (remove #a #f (Some.v (choose #a #f s)) s))) [SMTPat (choose #a #f s)] diff --git a/lib/FStar.Relational.fst b/lib/FStar.Relational.fst index fad23edb845..339c900f75c 100644 --- a/lib/FStar.Relational.fst +++ b/lib/FStar.Relational.fst @@ -30,7 +30,7 @@ let op_Hat_Star = rel_map2T (fun x y -> x * y) let op_Hat_Slash = rel_map2T (fun x y -> x / y) (* Some convenient list functions *) -val tl_rel: #a:Type -> l:double (list a){is_Cons (R.l l) /\ is_Cons (R.r l)}-> Tot (double (list a)) +val tl_rel: #a:Type -> l:double (list a){Cons? (R.l l) /\ Cons? (R.r l)}-> Tot (double (list a)) let tl_rel (R (_::xs) (_::ys)) = R xs ys let cons_rel (R x y) (R xs ys) = R (x::xs) (y::ys) (* Some convenient tuple functions *) diff --git a/lib/FStar.SeqProperties.fst b/lib/FStar.SeqProperties.fst index d0660651bc5..31776f0af07 100644 --- a/lib/FStar.SeqProperties.fst +++ b/lib/FStar.SeqProperties.fst @@ -406,9 +406,9 @@ val seq_find_aux : #a:Type -> f:(a -> Tot bool) -> l:seq a -> Pure (option a) (requires (forall (i:nat{ i < Seq.length l /\ i >= ctr}). not (f (Seq.index l i) ))) - (ensures (fun o -> (is_None o ==> (forall (i:nat{i < Seq.length l}). + (ensures (fun o -> (None? o ==> (forall (i:nat{i < Seq.length l}). not (f (Seq.index l i)))) - /\ (is_Some o ==> (f (Some.v o) + /\ (Some? o ==> (f (Some.v o) /\ (exists (i:nat{i < Seq.length l}). //{:pattern (found i)} o = Some (Seq.index l i)))))) @@ -425,8 +425,8 @@ let rec seq_find_aux f l ctr = val seq_find: #a:Type -> f:(a -> Tot bool) -> l:seq a -> Pure (option a) (requires True) - (ensures (fun o -> (is_None o ==> (forall (i:nat{i < Seq.length l}). not (f (Seq.index l i)))) - /\ (is_Some o + (ensures (fun o -> (None? o ==> (forall (i:nat{i < Seq.length l}). not (f (Seq.index l i)))) + /\ (Some? o ==> (f (Some.v o) /\ (exists (i:nat{i < Seq.length l}).{:pattern (found i)} found i /\ o = Some (Seq.index l i)))))) diff --git a/lib/allHyperHeap.fst b/lib/allHyperHeap.fst index 87379ce2102..7aa3911046c 100644 --- a/lib/allHyperHeap.fst +++ b/lib/allHyperHeap.fst @@ -33,6 +33,6 @@ sub_effect assume val pipe_right: 'a -> ('a -> 'b) -> 'b assume val pipe_left: ('a -> 'b) -> 'a -> 'b -assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> is_Err a /\ h==h') +assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h') assume val exit: int -> 'a assume val try_with: (unit -> 'a) -> (exn -> 'a) -> 'a diff --git a/lib/ml/MkPrims.ml b/lib/ml/MkPrims.ml index 6f1d689b1e6..c746d5ddcc4 100644 --- a/lib/ml/MkPrims.ml +++ b/lib/ml/MkPrims.ml @@ -30,19 +30,19 @@ end) -> struct | Left of ' p | Right of ' q - let is_Left = function Left _ -> true | Right _ -> false + let uu___is_Left = function Left _ -> true | Right _ -> false - let is_Right = function Left _ -> false | Right _ -> true + let uu___is_Right = function Left _ -> false | Right _ -> true type (' p, ' q) l_and = | And of ' p * ' q - let is_And _ = true + let uu___is_And _ = true type l__True = | T - let is_T _ = true + let uu___is_T _ = true type l__False = unit (*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there @@ -79,13 +79,13 @@ end) -> struct let op_disEquality x y = x<>y let op_AmpAmp x y = x && y let op_BarBar x y = x || y - let is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) - let is_Cons l = not (is_Nil l) + let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) + let uu___is_Cons l = not (uu___is_Nil l) let strcat x y = x ^ y - let is_Some = function (*consider redefining Option.isSome as this function*) + let uu___is_Some = function (*consider redefining Option.isSome as this function*) | Some _ -> true | None -> false - let is_None o = not (is_Some o) + let uu___is_None o = not (uu___is_Some o) let raise e = raise e let ___Some___v x = match x with @@ -96,11 +96,11 @@ end) -> struct | Inl of 'a | Inr of 'b - let is_Inl = function + let uu___is_Inl = function | Inl _ -> true | _ -> false - let is_Inr x = not (is_Inl x) + let uu___is_Inr x = not (uu___is_Inl x) let ___Inl___v x = match x with | Inl v -> v diff --git a/lib/prims.fst b/lib/prims.fst index a1c823d7aa8..a8531720568 100644 --- a/lib/prims.fst +++ b/lib/prims.fst @@ -273,12 +273,12 @@ kind ExPost (a:Type) = result a -> Type kind ExWP (a:Type) = ExPost a -> ExPre type ex_return (a:Type) (x:a) (p:ExPost a) = p (V x) type ex_bind_wlp (a:Type) (b:Type) (wlp1:ExWP a) (wlp2:(a -> ExWP b)) (p:ExPost b) = - (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if b2t (is_V ra1) + (forall (rb:result b). p rb \/ wlp1 (fun ra1 -> if b2t (V? ra1) then wlp2 (V.v ra1) (fun rb2 -> rb2=!=rb) else ra1 =!= rb)) type ex_bind_wp (a:Type) (b:Type) (wp1:ExWP a) (wlp1:ExWP a) (wp2:(a -> ExWP b)) (wlp2:(a -> ExWP b)) (p:ExPost b) = ex_bind_wlp a b wlp1 wlp2 p - /\ wp1 (fun ra1 -> (ITE (b2t (is_V ra1)) + /\ wp1 (fun ra1 -> (ITE (b2t (V? ra1)) (wp2 (V.v ra1) (fun rb2 -> True)) True)) type ex_if_then_else (a:Type) (p:Type) (wp_then:ExWP a) (wp_else:ExWP a) (post:ExPost a) = @@ -333,12 +333,12 @@ type all_bind_wp (heap:Type) (a:Type) (b:Type) (wp1:AllWP_h heap a) (wlp1:AllWP_h heap a) (wp2:(a -> AllWP_h heap b)) (wlp2:(a -> AllWP_h heap b)) (p:AllPost_h heap b) (h0:heap) = - (wp1 (fun ra h1 -> b2t(is_V ra) ==> wp2 (V.v ra) p h1) h0) + (wp1 (fun ra h1 -> b2t(V? ra) ==> wp2 (V.v ra) p h1) h0) type all_bind_wlp (heap:Type) (a:Type) (b:Type) (wlp1:AllWP_h heap a) (wlp2:(a -> AllWP_h heap b)) (p:AllPost_h heap b) (h0:heap) = (forall rb h. wlp1 (fun ra h1 -> - if b2t (is_V ra) + if b2t (V? ra) then wlp2 (V.v ra) (fun rb2 h2 -> rb=!=rb2 \/ h=!=h2) h1 else rb=!=ra \/ h=!=h1) h0 \/ p rb h) type all_if_then_else (heap:Type) (a:Type) (p:Type) diff --git a/src/extraction/modul.fs b/src/extraction/modul.fs index a910ab9ce6c..12783820213 100644 --- a/src/extraction/modul.fs +++ b/src/extraction/modul.fs @@ -42,10 +42,7 @@ let fail_exp (lid:lident) (t:typ) = Range.dummyRange let mangle_projector_lid (x: lident) : lident = - let projecteeName = x.ident in - let prefix, constrName = Util.prefix x.ns in - let mangledName = Ident.id_of_text ("___"^constrName.idText^"___"^projecteeName.idText) in - lid_of_ids (prefix@[mangledName]) + x let lident_as_mlsymbol (id : lident) : mlsymbol = id.ident.idText @@ -150,9 +147,9 @@ let extract_bundle env se = let ml_params = List.append vars (indices |> List.mapi (fun i _ -> "'dummyV" ^ Util.string_of_int i, 0)) in let tbody = match Util.find_opt (function RecordType _ -> true | _ -> false) ind.iquals with | Some (RecordType ids) -> - let _, c_ty = List.hd ctors in + let c_name, c_ty = List.hd ctors in assert (List.length ids = List.length c_ty); - let fields = List.map2 (fun lid ty -> lident_as_mlsymbol lid, ty) ids c_ty in + let fields = List.map2 (fun lid ty -> U.mk_field_projector_name_from_string c_name (lident_as_mlsymbol lid), ty) ids c_ty in MLTD_Record fields | _ -> MLTD_DType ctors in diff --git a/src/extraction/term.fs b/src/extraction/term.fs index 6fef0c5acd3..0ce3d171fa8 100644 --- a/src/extraction/term.fs +++ b/src/extraction/term.fs @@ -56,6 +56,20 @@ let eraseTypeDeep g t = Util.eraseTypeDeep (Util.udelta_unfold g) t module Print = FStar.Syntax.Print + +(* taramana 2016-10-31: we redefine +FStar.Extraction.ML.Util.record_field_path here because the desugaring +of field names has changed, but we cannot change the definition in +FStar.Extraction.ML.Util for now because it is used by legacy +extraction, which is still used in the bootstrapping process *) + +let record_field_path = function + | f::_ -> + let ns = f.ns in + ns |> List.map (fun id -> id.idText) + | _ -> failwith "impos" + + (********************************************************************************************) (* Some basic error reporting; all are fatal errors at this stage *) (********************************************************************************************) @@ -674,7 +688,7 @@ let maybe_eta_data_and_project_record (g:env) (qual : option) (residual let as_record qual e = match e.expr, qual with | MLE_CTor(_, args), Some (Record_ctor(_, fields)) -> - let path = Util.record_field_path fields in + let path = record_field_path fields in let fields = Util.record_fields fields args in with_ty e.mlty <| MLE_Record(path, fields) | _ -> e in diff --git a/src/extraction/uenv.fs b/src/extraction/uenv.fs index f653ec96060..03707056ed3 100644 --- a/src/extraction/uenv.fs +++ b/src/extraction/uenv.fs @@ -116,7 +116,7 @@ let maybe_mangle_type_projector (env:env) (fv:fv) : option = | None -> Some (m, n) | Some mangled -> - let modul, _ = Util.prefix m in + let modul = m in Some (modul, mangled) else None else None)) diff --git a/src/ocaml-output/FStar_Extraction_ML_Code.ml b/src/ocaml-output/FStar_Extraction_ML_Code.ml index 3814efbb66d..b0323336d17 100755 --- a/src/ocaml-output/FStar_Extraction_ML_Code.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Code.ml @@ -511,10 +511,9 @@ end let doc = (FStar_List.map (doc_of_mltype currentModule ((t_prio_tpl), (Left))) tys) in ( -let doc = (let _170_120 = (let _170_119 = (let _170_118 = (FStar_Format.text " * ") -in (FStar_Format.combine _170_118 doc)) -in (FStar_Format.hbox _170_119)) -in (FStar_Format.parens _170_120)) +let doc = (let _170_119 = (let _170_118 = (FStar_Format.combine (FStar_Format.text " * ") doc) +in (FStar_Format.hbox _170_118)) +in (FStar_Format.parens _170_119)) in doc)) end | FStar_Extraction_ML_Syntax.MLTY_Named (args, name) -> begin @@ -531,25 +530,21 @@ end ( let args = (FStar_List.map (doc_of_mltype currentModule ((min_op_prec), (NonAssoc))) args) -in (let _170_123 = (let _170_122 = (let _170_121 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_121 args)) -in (FStar_Format.hbox _170_122)) -in (FStar_Format.parens _170_123))) +in (let _170_121 = (let _170_120 = (FStar_Format.combine (FStar_Format.text ", ") args) +in (FStar_Format.hbox _170_120)) +in (FStar_Format.parens _170_121))) end) in ( let name = if (is_standard_type name) then begin -(let _170_125 = (let _170_124 = (as_standard_type name) -in (FStar_Option.get _170_124)) -in (Prims.snd _170_125)) +(let _170_123 = (let _170_122 = (as_standard_type name) +in (FStar_Option.get _170_122)) +in (Prims.snd _170_123)) end else begin (ptsym currentModule name) end -in (let _170_129 = (let _170_128 = (let _170_127 = (let _170_126 = (FStar_Format.text name) -in (_170_126)::[]) -in (args)::_170_127) -in (FStar_Format.reduce1 _170_128)) -in (FStar_Format.hbox _170_129)))) +in (let _170_124 = (FStar_Format.reduce1 ((args)::((FStar_Format.text name))::[])) +in (FStar_Format.hbox _170_124)))) end | FStar_Extraction_ML_Syntax.MLTY_Fun (t1, _75_229, t2) -> begin ( @@ -558,12 +553,9 @@ let d1 = (doc_of_mltype currentModule ((t_prio_fun), (Left)) t1) in ( let d2 = (doc_of_mltype currentModule ((t_prio_fun), (Right)) t2) -in (let _170_134 = (let _170_133 = (let _170_132 = (let _170_131 = (let _170_130 = (FStar_Format.text " -> ") -in (_170_130)::(d2)::[]) -in (d1)::_170_131) -in (FStar_Format.reduce1 _170_132)) -in (FStar_Format.hbox _170_133)) -in (maybe_paren outer t_prio_fun _170_134)))) +in (let _170_126 = (let _170_125 = (FStar_Format.reduce1 ((d1)::((FStar_Format.text " -> "))::(d2)::[])) +in (FStar_Format.hbox _170_125)) +in (maybe_paren outer t_prio_fun _170_126)))) end | FStar_Extraction_ML_Syntax.MLTY_Top -> begin if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin @@ -572,8 +564,8 @@ end else begin (FStar_Format.text "Obj.t") end end)) -and doc_of_mltype : FStar_Extraction_ML_Syntax.mlsymbol -> level -> FStar_Extraction_ML_Syntax.mlty -> FStar_Format.doc = (fun currentModule outer ty -> (let _170_138 = (FStar_Extraction_ML_Util.resugar_mlty ty) -in (doc_of_mltype' currentModule outer _170_138))) +and doc_of_mltype : FStar_Extraction_ML_Syntax.mlsymbol -> level -> FStar_Extraction_ML_Syntax.mlty -> FStar_Format.doc = (fun currentModule outer ty -> (let _170_130 = (FStar_Extraction_ML_Util.resugar_mlty ty) +in (doc_of_mltype' currentModule outer _170_130))) let rec doc_of_expr : FStar_Extraction_ML_Syntax.mlsymbol -> level -> FStar_Extraction_ML_Syntax.mlexpr -> FStar_Format.doc = (fun currentModule outer e -> (match (e.FStar_Extraction_ML_Syntax.expr) with @@ -582,17 +574,11 @@ let rec doc_of_expr : FStar_Extraction_ML_Syntax.mlsymbol -> level -> FStar_ let doc = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) in if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin -(let _170_161 = (let _170_160 = (let _170_159 = (FStar_Format.text "Prims.checked_cast") -in (_170_159)::(doc)::[]) -in (FStar_Format.reduce _170_160)) -in (FStar_Format.parens _170_161)) +(let _170_151 = (FStar_Format.reduce (((FStar_Format.text "Prims.checked_cast"))::(doc)::[])) +in (FStar_Format.parens _170_151)) end else begin -(let _170_166 = (let _170_165 = (let _170_164 = (FStar_Format.text "Obj.magic ") -in (let _170_163 = (let _170_162 = (FStar_Format.parens doc) -in (_170_162)::[]) -in (_170_164)::_170_163)) -in (FStar_Format.reduce _170_165)) -in (FStar_Format.parens _170_166)) +(let _170_152 = (FStar_Format.reduce (((FStar_Format.text "Obj.magic "))::((FStar_Format.parens doc))::[])) +in (FStar_Format.parens _170_152)) end) end | FStar_Extraction_ML_Syntax.MLE_Seq (es) -> begin @@ -601,22 +587,19 @@ end let docs = (FStar_List.map (doc_of_expr currentModule ((min_op_prec), (NonAssoc))) es) in ( -let docs = (FStar_List.map (fun d -> (let _170_170 = (let _170_169 = (let _170_168 = (FStar_Format.text ";") -in (_170_168)::(FStar_Format.hardline)::[]) -in (d)::_170_169) -in (FStar_Format.reduce _170_170))) docs) +let docs = (FStar_List.map (fun d -> (FStar_Format.reduce ((d)::((FStar_Format.text ";"))::(FStar_Format.hardline)::[]))) docs) in (FStar_Format.reduce docs))) end | FStar_Extraction_ML_Syntax.MLE_Const (c) -> begin -(let _170_171 = (string_of_mlconstant c) -in (FStar_Format.text _170_171)) +(let _170_154 = (string_of_mlconstant c) +in (FStar_Format.text _170_154)) end | FStar_Extraction_ML_Syntax.MLE_Var (x, _75_257) -> begin (FStar_Format.text x) end | FStar_Extraction_ML_Syntax.MLE_Name (path) -> begin -(let _170_172 = (ptsym currentModule path) -in (FStar_Format.text _170_172)) +(let _170_155 = (ptsym currentModule path) +in (FStar_Format.text _170_155)) end | FStar_Extraction_ML_Syntax.MLE_Record (path, fields) -> begin ( @@ -626,25 +609,22 @@ let for1 = (fun _75_269 -> (match (_75_269) with ( let doc = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) -in (let _170_179 = (let _170_178 = (let _170_175 = (ptsym currentModule ((path), (name))) -in (FStar_Format.text _170_175)) -in (let _170_177 = (let _170_176 = (FStar_Format.text "=") -in (_170_176)::(doc)::[]) -in (_170_178)::_170_177)) -in (FStar_Format.reduce1 _170_179))) +in (let _170_160 = (let _170_159 = (let _170_158 = (ptsym currentModule ((path), (name))) +in (FStar_Format.text _170_158)) +in (_170_159)::((FStar_Format.text "="))::(doc)::[]) +in (FStar_Format.reduce1 _170_160))) end)) -in (let _170_182 = (let _170_181 = (FStar_Format.text "; ") -in (let _170_180 = (FStar_List.map for1 fields) -in (FStar_Format.combine _170_181 _170_180))) -in (FStar_Format.cbrackets _170_182))) +in (let _170_162 = (let _170_161 = (FStar_List.map for1 fields) +in (FStar_Format.combine (FStar_Format.text "; ") _170_161)) +in (FStar_Format.cbrackets _170_162))) end | FStar_Extraction_ML_Syntax.MLE_CTor (ctor, []) -> begin ( let name = if (is_standard_constructor ctor) then begin -(let _170_184 = (let _170_183 = (as_standard_constructor ctor) -in (FStar_Option.get _170_183)) -in (Prims.snd _170_184)) +(let _170_164 = (let _170_163 = (as_standard_constructor ctor) +in (FStar_Option.get _170_163)) +in (Prims.snd _170_164)) end else begin (ptctor currentModule ctor) end @@ -654,9 +634,9 @@ end ( let name = if (is_standard_constructor ctor) then begin -(let _170_186 = (let _170_185 = (as_standard_constructor ctor) -in (FStar_Option.get _170_185)) -in (Prims.snd _170_186)) +(let _170_166 = (let _170_165 = (as_standard_constructor ctor) +in (FStar_Option.get _170_165)) +in (Prims.snd _170_166)) end else begin (ptctor currentModule ctor) end @@ -667,43 +647,36 @@ in ( let doc = (match (((name), (args))) with | ("::", (x)::(xs)::[]) -> begin -(let _170_190 = (let _170_189 = (FStar_Format.parens x) -in (let _170_188 = (let _170_187 = (FStar_Format.text "::") -in (_170_187)::(xs)::[]) -in (_170_189)::_170_188)) -in (FStar_Format.reduce _170_190)) +(FStar_Format.reduce (((FStar_Format.parens x))::((FStar_Format.text "::"))::(xs)::[])) end | (_75_288, _75_290) -> begin -(let _170_196 = (let _170_195 = (FStar_Format.text name) -in (let _170_194 = (let _170_193 = (let _170_192 = (let _170_191 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_191 args)) -in (FStar_Format.parens _170_192)) -in (_170_193)::[]) -in (_170_195)::_170_194)) -in (FStar_Format.reduce1 _170_196)) +(let _170_170 = (let _170_169 = (let _170_168 = (let _170_167 = (FStar_Format.combine (FStar_Format.text ", ") args) +in (FStar_Format.parens _170_167)) +in (_170_168)::[]) +in ((FStar_Format.text name))::_170_169) +in (FStar_Format.reduce1 _170_170)) end) in (maybe_paren outer e_app_prio doc)))) end | FStar_Extraction_ML_Syntax.MLE_Tuple (es) -> begin ( -let docs = (FStar_List.map (fun x -> (let _170_198 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) x) -in (FStar_Format.parens _170_198))) es) +let docs = (FStar_List.map (fun x -> (let _170_172 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) x) +in (FStar_Format.parens _170_172))) es) in ( -let docs = (let _170_200 = (let _170_199 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_199 docs)) -in (FStar_Format.parens _170_200)) +let docs = (let _170_173 = (FStar_Format.combine (FStar_Format.text ", ") docs) +in (FStar_Format.parens _170_173)) in docs)) end | FStar_Extraction_ML_Syntax.MLE_Let ((rec_, _75_300, lets), body) -> begin ( let pre = if (e.FStar_Extraction_ML_Syntax.loc <> FStar_Extraction_ML_Syntax.dummy_loc) then begin -(let _170_203 = (let _170_202 = (let _170_201 = (doc_of_loc e.FStar_Extraction_ML_Syntax.loc) -in (_170_201)::[]) -in (FStar_Format.hardline)::_170_202) -in (FStar_Format.reduce _170_203)) +(let _170_176 = (let _170_175 = (let _170_174 = (doc_of_loc e.FStar_Extraction_ML_Syntax.loc) +in (_170_174)::[]) +in (FStar_Format.hardline)::_170_175) +in (FStar_Format.reduce _170_176)) end else begin FStar_Format.empty end @@ -713,14 +686,12 @@ let doc = (doc_of_lets currentModule ((rec_), (false), (lets))) in ( let body = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) body) -in (let _170_210 = (let _170_209 = (let _170_208 = (let _170_207 = (let _170_206 = (let _170_205 = (let _170_204 = (FStar_Format.text "in") -in (_170_204)::(body)::[]) -in (FStar_Format.reduce1 _170_205)) -in (_170_206)::[]) -in (doc)::_170_207) -in (pre)::_170_208) -in (FStar_Format.combine FStar_Format.hardline _170_209)) -in (FStar_Format.parens _170_210))))) +in (let _170_181 = (let _170_180 = (let _170_179 = (let _170_178 = (let _170_177 = (FStar_Format.reduce1 (((FStar_Format.text "in"))::(body)::[])) +in (_170_177)::[]) +in (doc)::_170_178) +in (pre)::_170_179) +in (FStar_Format.combine FStar_Format.hardline _170_180)) +in (FStar_Format.parens _170_181))))) end | FStar_Extraction_ML_Syntax.MLE_App (e, args) -> begin (match (((e.FStar_Extraction_ML_Syntax.expr), (args))) with @@ -755,8 +726,8 @@ let e = (doc_of_expr currentModule ((e_app_prio), (ILeft)) e) in ( let args = (FStar_List.map (doc_of_expr currentModule ((e_app_prio), (IRight))) args) -in (let _170_211 = (FStar_Format.reduce1 ((e)::args)) -in (FStar_Format.parens _170_211)))) +in (let _170_182 = (FStar_Format.reduce1 ((e)::args)) +in (FStar_Format.parens _170_182)))) end) end | FStar_Extraction_ML_Syntax.MLE_Proj (e, f) -> begin @@ -766,20 +737,14 @@ let e = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) in ( let doc = if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin -(let _170_216 = (let _170_215 = (let _170_214 = (FStar_Format.text ".") -in (let _170_213 = (let _170_212 = (FStar_Format.text (Prims.snd f)) -in (_170_212)::[]) -in (_170_214)::_170_213)) -in (e)::_170_215) -in (FStar_Format.reduce _170_216)) +(FStar_Format.reduce ((e)::((FStar_Format.text "."))::((FStar_Format.text (Prims.snd f)))::[])) end else begin -(let _170_222 = (let _170_221 = (let _170_220 = (FStar_Format.text ".") -in (let _170_219 = (let _170_218 = (let _170_217 = (ptsym currentModule f) -in (FStar_Format.text _170_217)) -in (_170_218)::[]) -in (_170_220)::_170_219)) -in (e)::_170_221) -in (FStar_Format.reduce _170_222)) +(let _170_187 = (let _170_186 = (let _170_185 = (let _170_184 = (let _170_183 = (ptsym currentModule f) +in (FStar_Format.text _170_183)) +in (_170_184)::[]) +in ((FStar_Format.text "."))::_170_185) +in (e)::_170_186) +in (FStar_Format.reduce _170_187)) end in doc)) end @@ -787,25 +752,20 @@ end ( let bvar_annot = (fun x xt -> if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin -(let _170_238 = (let _170_237 = (FStar_Format.text "(") -in (let _170_236 = (let _170_235 = (FStar_Format.text x) -in (let _170_234 = (let _170_233 = (match (xt) with +(let _170_198 = (let _170_197 = (let _170_196 = (let _170_195 = (match (xt) with | Some (xxt) -> begin -(let _170_230 = (let _170_229 = (FStar_Format.text " : ") -in (let _170_228 = (let _170_227 = (doc_of_mltype currentModule outer xxt) -in (_170_227)::[]) -in (_170_229)::_170_228)) -in (FStar_Format.reduce1 _170_230)) +(let _170_194 = (let _170_193 = (let _170_192 = (doc_of_mltype currentModule outer xxt) +in (_170_192)::[]) +in ((FStar_Format.text " : "))::_170_193) +in (FStar_Format.reduce1 _170_194)) end | _75_418 -> begin (FStar_Format.text "") end) -in (let _170_232 = (let _170_231 = (FStar_Format.text ")") -in (_170_231)::[]) -in (_170_233)::_170_232)) -in (_170_235)::_170_234)) -in (_170_237)::_170_236)) -in (FStar_Format.reduce1 _170_238)) +in (_170_195)::((FStar_Format.text ")"))::[]) +in ((FStar_Format.text x))::_170_196) +in ((FStar_Format.text "("))::_170_197) +in (FStar_Format.reduce1 _170_198)) end else begin (FStar_Format.text x) end) @@ -820,13 +780,10 @@ in ( let body = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) body) in ( -let doc = (let _170_245 = (let _170_244 = (FStar_Format.text "fun") -in (let _170_243 = (let _170_242 = (FStar_Format.reduce1 ids) -in (let _170_241 = (let _170_240 = (FStar_Format.text "->") -in (_170_240)::(body)::[]) -in (_170_242)::_170_241)) -in (_170_244)::_170_243)) -in (FStar_Format.reduce1 _170_245)) +let doc = (let _170_202 = (let _170_201 = (let _170_200 = (FStar_Format.reduce1 ids) +in (_170_200)::((FStar_Format.text "->"))::(body)::[]) +in ((FStar_Format.text "fun"))::_170_201) +in (FStar_Format.reduce1 _170_202)) in (FStar_Format.parens doc))))) end | FStar_Extraction_ML_Syntax.MLE_If (cond, e1, None) -> begin @@ -835,20 +792,11 @@ end let cond = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) cond) in ( -let doc = (let _170_258 = (let _170_257 = (let _170_252 = (let _170_251 = (FStar_Format.text "if") -in (let _170_250 = (let _170_249 = (let _170_248 = (FStar_Format.text "then") -in (let _170_247 = (let _170_246 = (FStar_Format.text "begin") -in (_170_246)::[]) -in (_170_248)::_170_247)) -in (cond)::_170_249) -in (_170_251)::_170_250)) -in (FStar_Format.reduce1 _170_252)) -in (let _170_256 = (let _170_255 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e1) -in (let _170_254 = (let _170_253 = (FStar_Format.text "end") -in (_170_253)::[]) -in (_170_255)::_170_254)) -in (_170_257)::_170_256)) -in (FStar_Format.combine FStar_Format.hardline _170_258)) +let doc = (let _170_206 = (let _170_205 = (FStar_Format.reduce1 (((FStar_Format.text "if"))::(cond)::((FStar_Format.text "then"))::((FStar_Format.text "begin"))::[])) +in (let _170_204 = (let _170_203 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e1) +in (_170_203)::((FStar_Format.text "end"))::[]) +in (_170_205)::_170_204)) +in (FStar_Format.combine FStar_Format.hardline _170_206)) in (maybe_paren outer e_bin_prio_if doc))) end | FStar_Extraction_ML_Syntax.MLE_If (cond, e1, Some (e2)) -> begin @@ -857,30 +805,15 @@ end let cond = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) cond) in ( -let doc = (let _170_281 = (let _170_280 = (let _170_265 = (let _170_264 = (FStar_Format.text "if") -in (let _170_263 = (let _170_262 = (let _170_261 = (FStar_Format.text "then") -in (let _170_260 = (let _170_259 = (FStar_Format.text "begin") -in (_170_259)::[]) -in (_170_261)::_170_260)) -in (cond)::_170_262) -in (_170_264)::_170_263)) -in (FStar_Format.reduce1 _170_265)) -in (let _170_279 = (let _170_278 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e1) -in (let _170_277 = (let _170_276 = (let _170_271 = (let _170_270 = (FStar_Format.text "end") -in (let _170_269 = (let _170_268 = (FStar_Format.text "else") -in (let _170_267 = (let _170_266 = (FStar_Format.text "begin") -in (_170_266)::[]) -in (_170_268)::_170_267)) -in (_170_270)::_170_269)) -in (FStar_Format.reduce1 _170_271)) -in (let _170_275 = (let _170_274 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e2) -in (let _170_273 = (let _170_272 = (FStar_Format.text "end") -in (_170_272)::[]) -in (_170_274)::_170_273)) -in (_170_276)::_170_275)) -in (_170_278)::_170_277)) -in (_170_280)::_170_279)) -in (FStar_Format.combine FStar_Format.hardline _170_281)) +let doc = (let _170_214 = (let _170_213 = (FStar_Format.reduce1 (((FStar_Format.text "if"))::(cond)::((FStar_Format.text "then"))::((FStar_Format.text "begin"))::[])) +in (let _170_212 = (let _170_211 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e1) +in (let _170_210 = (let _170_209 = (FStar_Format.reduce1 (((FStar_Format.text "end"))::((FStar_Format.text "else"))::((FStar_Format.text "begin"))::[])) +in (let _170_208 = (let _170_207 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e2) +in (_170_207)::((FStar_Format.text "end"))::[]) +in (_170_209)::_170_208)) +in (_170_211)::_170_210)) +in (_170_213)::_170_212)) +in (FStar_Format.combine FStar_Format.hardline _170_214)) in (maybe_paren outer e_bin_prio_if doc))) end | FStar_Extraction_ML_Syntax.MLE_Match (cond, pats) -> begin @@ -892,58 +825,47 @@ in ( let pats = (FStar_List.map (doc_of_branch currentModule) pats) in ( -let doc = (let _170_288 = (let _170_287 = (let _170_286 = (FStar_Format.text "match") -in (let _170_285 = (let _170_284 = (FStar_Format.parens cond) -in (let _170_283 = (let _170_282 = (FStar_Format.text "with") -in (_170_282)::[]) -in (_170_284)::_170_283)) -in (_170_286)::_170_285)) -in (FStar_Format.reduce1 _170_287)) -in (_170_288)::pats) +let doc = (let _170_215 = (FStar_Format.reduce1 (((FStar_Format.text "match"))::((FStar_Format.parens cond))::((FStar_Format.text "with"))::[])) +in (_170_215)::pats) in ( let doc = (FStar_Format.combine FStar_Format.hardline doc) in (FStar_Format.parens doc))))) end | FStar_Extraction_ML_Syntax.MLE_Raise (exn, []) -> begin -(let _170_293 = (let _170_292 = (FStar_Format.text "raise") -in (let _170_291 = (let _170_290 = (let _170_289 = (ptctor currentModule exn) -in (FStar_Format.text _170_289)) -in (_170_290)::[]) -in (_170_292)::_170_291)) -in (FStar_Format.reduce1 _170_293)) +(let _170_219 = (let _170_218 = (let _170_217 = (let _170_216 = (ptctor currentModule exn) +in (FStar_Format.text _170_216)) +in (_170_217)::[]) +in ((FStar_Format.text "raise"))::_170_218) +in (FStar_Format.reduce1 _170_219)) end | FStar_Extraction_ML_Syntax.MLE_Raise (exn, args) -> begin ( let args = (FStar_List.map (doc_of_expr currentModule ((min_op_prec), (NonAssoc))) args) -in (let _170_302 = (let _170_301 = (FStar_Format.text "raise") -in (let _170_300 = (let _170_299 = (let _170_294 = (ptctor currentModule exn) -in (FStar_Format.text _170_294)) -in (let _170_298 = (let _170_297 = (let _170_296 = (let _170_295 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_295 args)) -in (FStar_Format.parens _170_296)) -in (_170_297)::[]) -in (_170_299)::_170_298)) -in (_170_301)::_170_300)) -in (FStar_Format.reduce1 _170_302))) +in (let _170_226 = (let _170_225 = (let _170_224 = (let _170_220 = (ptctor currentModule exn) +in (FStar_Format.text _170_220)) +in (let _170_223 = (let _170_222 = (let _170_221 = (FStar_Format.combine (FStar_Format.text ", ") args) +in (FStar_Format.parens _170_221)) +in (_170_222)::[]) +in (_170_224)::_170_223)) +in ((FStar_Format.text "raise"))::_170_225) +in (FStar_Format.reduce1 _170_226))) end | FStar_Extraction_ML_Syntax.MLE_Try (e, pats) -> begin -(let _170_311 = (let _170_310 = (FStar_Format.text "try") -in (let _170_309 = (let _170_308 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) -in (let _170_307 = (let _170_306 = (FStar_Format.text "with") -in (let _170_305 = (let _170_304 = (let _170_303 = (FStar_List.map (doc_of_branch currentModule) pats) -in (FStar_Format.combine FStar_Format.hardline _170_303)) -in (_170_304)::[]) -in (_170_306)::_170_305)) -in (_170_308)::_170_307)) -in (_170_310)::_170_309)) -in (FStar_Format.combine FStar_Format.hardline _170_311)) +(let _170_233 = (let _170_232 = (let _170_231 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) +in (let _170_230 = (let _170_229 = (let _170_228 = (let _170_227 = (FStar_List.map (doc_of_branch currentModule) pats) +in (FStar_Format.combine FStar_Format.hardline _170_227)) +in (_170_228)::[]) +in ((FStar_Format.text "with"))::_170_229) +in (_170_231)::_170_230)) +in ((FStar_Format.text "try"))::_170_232) +in (FStar_Format.combine FStar_Format.hardline _170_233)) end)) and doc_of_binop : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlpath -> FStar_Extraction_ML_Syntax.mlexpr -> FStar_Extraction_ML_Syntax.mlexpr -> FStar_Format.doc = (fun currentModule p e1 e2 -> ( -let _75_472 = (let _170_316 = (as_bin_op p) -in (FStar_Option.get _170_316)) +let _75_472 = (let _170_238 = (as_bin_op p) +in (FStar_Option.get _170_238)) in (match (_75_472) with | (_75_469, prio, txt) -> begin ( @@ -954,16 +876,13 @@ in ( let e2 = (doc_of_expr currentModule ((prio), (Right)) e2) in ( -let doc = (let _170_319 = (let _170_318 = (let _170_317 = (FStar_Format.text txt) -in (_170_317)::(e2)::[]) -in (e1)::_170_318) -in (FStar_Format.reduce1 _170_319)) +let doc = (FStar_Format.reduce1 ((e1)::((FStar_Format.text txt))::(e2)::[])) in (FStar_Format.parens doc)))) end))) and doc_of_uniop : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlpath -> FStar_Extraction_ML_Syntax.mlexpr -> FStar_Format.doc = (fun currentModule p e1 -> ( -let _75_482 = (let _170_323 = (as_uni_op p) -in (FStar_Option.get _170_323)) +let _75_482 = (let _170_242 = (as_uni_op p) +in (FStar_Option.get _170_242)) in (match (_75_482) with | (_75_480, txt) -> begin ( @@ -971,11 +890,7 @@ in (match (_75_482) with let e1 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e1) in ( -let doc = (let _170_327 = (let _170_326 = (FStar_Format.text txt) -in (let _170_325 = (let _170_324 = (FStar_Format.parens e1) -in (_170_324)::[]) -in (_170_326)::_170_325)) -in (FStar_Format.reduce1 _170_327)) +let doc = (FStar_Format.reduce1 (((FStar_Format.text txt))::((FStar_Format.parens e1))::[])) in (FStar_Format.parens doc))) end))) and doc_of_pattern : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlpattern -> FStar_Format.doc = (fun currentModule pattern -> (match (pattern) with @@ -983,8 +898,8 @@ and doc_of_pattern : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_M (FStar_Format.text "_") end | FStar_Extraction_ML_Syntax.MLP_Const (c) -> begin -(let _170_330 = (string_of_mlconstant c) -in (FStar_Format.text _170_330)) +(let _170_245 = (string_of_mlconstant c) +in (FStar_Format.text _170_245)) end | FStar_Extraction_ML_Syntax.MLP_Var (x) -> begin (FStar_Format.text (Prims.fst x)) @@ -994,27 +909,25 @@ end let for1 = (fun _75_499 -> (match (_75_499) with | (name, p) -> begin -(let _170_339 = (let _170_338 = (let _170_333 = (ptsym currentModule ((path), (name))) -in (FStar_Format.text _170_333)) -in (let _170_337 = (let _170_336 = (FStar_Format.text "=") -in (let _170_335 = (let _170_334 = (doc_of_pattern currentModule p) -in (_170_334)::[]) -in (_170_336)::_170_335)) -in (_170_338)::_170_337)) -in (FStar_Format.reduce1 _170_339)) +(let _170_253 = (let _170_252 = (let _170_248 = (ptsym currentModule ((path), (name))) +in (FStar_Format.text _170_248)) +in (let _170_251 = (let _170_250 = (let _170_249 = (doc_of_pattern currentModule p) +in (_170_249)::[]) +in ((FStar_Format.text "="))::_170_250) +in (_170_252)::_170_251)) +in (FStar_Format.reduce1 _170_253)) end)) -in (let _170_342 = (let _170_341 = (FStar_Format.text "; ") -in (let _170_340 = (FStar_List.map for1 fields) -in (FStar_Format.combine _170_341 _170_340))) -in (FStar_Format.cbrackets _170_342))) +in (let _170_255 = (let _170_254 = (FStar_List.map for1 fields) +in (FStar_Format.combine (FStar_Format.text "; ") _170_254)) +in (FStar_Format.cbrackets _170_255))) end | FStar_Extraction_ML_Syntax.MLP_CTor (ctor, []) -> begin ( let name = if (is_standard_constructor ctor) then begin -(let _170_344 = (let _170_343 = (as_standard_constructor ctor) -in (FStar_Option.get _170_343)) -in (Prims.snd _170_344)) +(let _170_257 = (let _170_256 = (as_standard_constructor ctor) +in (FStar_Option.get _170_256)) +in (Prims.snd _170_257)) end else begin (ptctor currentModule ctor) end @@ -1024,9 +937,9 @@ end ( let name = if (is_standard_constructor ctor) then begin -(let _170_346 = (let _170_345 = (as_standard_constructor ctor) -in (FStar_Option.get _170_345)) -in (Prims.snd _170_346)) +(let _170_259 = (let _170_258 = (as_standard_constructor ctor) +in (FStar_Option.get _170_258)) +in (Prims.snd _170_259)) end else begin (ptctor currentModule ctor) end @@ -1034,32 +947,28 @@ in ( let doc = (match (((name), (pats))) with | ("::", (x)::(xs)::[]) -> begin -(let _170_353 = (let _170_352 = (let _170_347 = (doc_of_pattern currentModule x) -in (FStar_Format.parens _170_347)) -in (let _170_351 = (let _170_350 = (FStar_Format.text "::") -in (let _170_349 = (let _170_348 = (doc_of_pattern currentModule xs) -in (_170_348)::[]) -in (_170_350)::_170_349)) -in (_170_352)::_170_351)) -in (FStar_Format.reduce _170_353)) +(let _170_265 = (let _170_264 = (let _170_260 = (doc_of_pattern currentModule x) +in (FStar_Format.parens _170_260)) +in (let _170_263 = (let _170_262 = (let _170_261 = (doc_of_pattern currentModule xs) +in (_170_261)::[]) +in ((FStar_Format.text "::"))::_170_262) +in (_170_264)::_170_263)) +in (FStar_Format.reduce _170_265)) end | (_75_516, (FStar_Extraction_ML_Syntax.MLP_Tuple (_75_518))::[]) -> begin -(let _170_358 = (let _170_357 = (FStar_Format.text name) -in (let _170_356 = (let _170_355 = (let _170_354 = (FStar_List.hd pats) -in (doc_of_pattern currentModule _170_354)) -in (_170_355)::[]) -in (_170_357)::_170_356)) -in (FStar_Format.reduce1 _170_358)) +(let _170_269 = (let _170_268 = (let _170_267 = (let _170_266 = (FStar_List.hd pats) +in (doc_of_pattern currentModule _170_266)) +in (_170_267)::[]) +in ((FStar_Format.text name))::_170_268) +in (FStar_Format.reduce1 _170_269)) end | _75_523 -> begin -(let _170_365 = (let _170_364 = (FStar_Format.text name) -in (let _170_363 = (let _170_362 = (let _170_361 = (let _170_360 = (FStar_Format.text ", ") -in (let _170_359 = (FStar_List.map (doc_of_pattern currentModule) pats) -in (FStar_Format.combine _170_360 _170_359))) -in (FStar_Format.parens _170_361)) -in (_170_362)::[]) -in (_170_364)::_170_363)) -in (FStar_Format.reduce1 _170_365)) +(let _170_274 = (let _170_273 = (let _170_272 = (let _170_271 = (let _170_270 = (FStar_List.map (doc_of_pattern currentModule) pats) +in (FStar_Format.combine (FStar_Format.text ", ") _170_270)) +in (FStar_Format.parens _170_271)) +in (_170_272)::[]) +in ((FStar_Format.text name))::_170_273) +in (FStar_Format.reduce1 _170_274)) end) in (maybe_paren ((min_op_prec), (NonAssoc)) e_app_prio doc))) end @@ -1067,9 +976,8 @@ end ( let ps = (FStar_List.map (doc_of_pattern currentModule) ps) -in (let _170_367 = (let _170_366 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_366 ps)) -in (FStar_Format.parens _170_367))) +in (let _170_275 = (FStar_Format.combine (FStar_Format.text ", ") ps) +in (FStar_Format.parens _170_275))) end | FStar_Extraction_ML_Syntax.MLP_Branch (ps) -> begin ( @@ -1078,8 +986,7 @@ let ps = (FStar_List.map (doc_of_pattern currentModule) ps) in ( let ps = (FStar_List.map FStar_Format.parens ps) -in (let _170_368 = (FStar_Format.text " | ") -in (FStar_Format.combine _170_368 ps)))) +in (FStar_Format.combine (FStar_Format.text " | ") ps))) end)) and doc_of_branch : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlbranch -> FStar_Format.doc = (fun currentModule _75_536 -> (match (_75_536) with | (p, cond, e) -> begin @@ -1087,36 +994,25 @@ and doc_of_branch : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML let case = (match (cond) with | None -> begin -(let _170_374 = (let _170_373 = (FStar_Format.text "|") -in (let _170_372 = (let _170_371 = (doc_of_pattern currentModule p) -in (_170_371)::[]) -in (_170_373)::_170_372)) -in (FStar_Format.reduce1 _170_374)) +(let _170_280 = (let _170_279 = (let _170_278 = (doc_of_pattern currentModule p) +in (_170_278)::[]) +in ((FStar_Format.text "|"))::_170_279) +in (FStar_Format.reduce1 _170_280)) end | Some (c) -> begin ( let c = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) c) -in (let _170_380 = (let _170_379 = (FStar_Format.text "|") -in (let _170_378 = (let _170_377 = (doc_of_pattern currentModule p) -in (let _170_376 = (let _170_375 = (FStar_Format.text "when") -in (_170_375)::(c)::[]) -in (_170_377)::_170_376)) -in (_170_379)::_170_378)) -in (FStar_Format.reduce1 _170_380))) +in (let _170_283 = (let _170_282 = (let _170_281 = (doc_of_pattern currentModule p) +in (_170_281)::((FStar_Format.text "when"))::(c)::[]) +in ((FStar_Format.text "|"))::_170_282) +in (FStar_Format.reduce1 _170_283))) end) -in (let _170_391 = (let _170_390 = (let _170_385 = (let _170_384 = (let _170_383 = (FStar_Format.text "->") -in (let _170_382 = (let _170_381 = (FStar_Format.text "begin") -in (_170_381)::[]) -in (_170_383)::_170_382)) -in (case)::_170_384) -in (FStar_Format.reduce1 _170_385)) -in (let _170_389 = (let _170_388 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) -in (let _170_387 = (let _170_386 = (FStar_Format.text "end") -in (_170_386)::[]) -in (_170_388)::_170_387)) -in (_170_390)::_170_389)) -in (FStar_Format.combine FStar_Format.hardline _170_391))) +in (let _170_287 = (let _170_286 = (FStar_Format.reduce1 ((case)::((FStar_Format.text "->"))::((FStar_Format.text "begin"))::[])) +in (let _170_285 = (let _170_284 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) +in (_170_284)::((FStar_Format.text "end"))::[]) +in (_170_286)::_170_285)) +in (FStar_Format.combine FStar_Format.hardline _170_287))) end)) and doc_of_lets : FStar_Extraction_ML_Syntax.mlsymbol -> (FStar_Extraction_ML_Syntax.mlletflavor * Prims.bool * FStar_Extraction_ML_Syntax.mllb Prims.list) -> FStar_Format.doc = (fun currentModule _75_546 -> (match (_75_546) with | (rec_, top_level, lets) -> begin @@ -1150,9 +1046,7 @@ end ( let ty = (doc_of_mltype currentModule ((min_op_prec), (NonAssoc)) ty) -in (let _170_398 = (let _170_397 = (FStar_Format.text ":") -in (_170_397)::(ty)::[]) -in (FStar_Format.reduce1 _170_398))) +in (FStar_Format.reduce1 (((FStar_Format.text ":"))::(ty)::[]))) end) end else begin if top_level then begin @@ -1164,32 +1058,22 @@ end ( let ty = (doc_of_mltype currentModule ((min_op_prec), (NonAssoc)) ty) -in (let _170_400 = (let _170_399 = (FStar_Format.text ":") -in (_170_399)::(ty)::[]) -in (FStar_Format.reduce1 _170_400))) +in (FStar_Format.reduce1 (((FStar_Format.text ":"))::(ty)::[]))) end) end else begin (FStar_Format.text "") end end end -in (let _170_407 = (let _170_406 = (FStar_Format.text (FStar_Extraction_ML_Syntax.idsym name)) -in (let _170_405 = (let _170_404 = (FStar_Format.reduce1 ids) -in (let _170_403 = (let _170_402 = (let _170_401 = (FStar_Format.text "=") -in (_170_401)::(e)::[]) -in (ty_annot)::_170_402) -in (_170_404)::_170_403)) -in (_170_406)::_170_405)) -in (FStar_Format.reduce1 _170_407)))))) +in (let _170_295 = (let _170_294 = (let _170_293 = (FStar_Format.reduce1 ids) +in (_170_293)::(ty_annot)::((FStar_Format.text "="))::(e)::[]) +in ((FStar_Format.text (FStar_Extraction_ML_Syntax.idsym name)))::_170_294) +in (FStar_Format.reduce1 _170_295)))))) end)) in ( let letdoc = if (rec_ = FStar_Extraction_ML_Syntax.Rec) then begin -(let _170_411 = (let _170_410 = (FStar_Format.text "let") -in (let _170_409 = (let _170_408 = (FStar_Format.text "rec") -in (_170_408)::[]) -in (_170_410)::_170_409)) -in (FStar_Format.reduce1 _170_411)) +(FStar_Format.reduce1 (((FStar_Format.text "let"))::((FStar_Format.text "rec"))::[])) end else begin (FStar_Format.text "let") end @@ -1198,13 +1082,11 @@ in ( let lets = (FStar_List.map for1 lets) in ( -let lets = (FStar_List.mapi (fun i doc -> (let _170_415 = (let _170_414 = if (i = (Prims.parse_int "0")) then begin +let lets = (FStar_List.mapi (fun i doc -> (FStar_Format.reduce1 ((if (i = (Prims.parse_int "0")) then begin letdoc end else begin (FStar_Format.text "and") -end -in (_170_414)::(doc)::[]) -in (FStar_Format.reduce1 _170_415))) lets) +end)::(doc)::[]))) lets) in (FStar_Format.combine FStar_Format.hardline lets))))) end)) and doc_of_loc : FStar_Extraction_ML_Syntax.mlloc -> FStar_Format.doc = (fun _75_600 -> (match (_75_600) with @@ -1215,13 +1097,7 @@ end else begin ( let file = (FStar_Util.basename file) -in (let _170_422 = (let _170_421 = (FStar_Format.text "#") -in (let _170_420 = (let _170_419 = (FStar_Format.num lineno) -in (let _170_418 = (let _170_417 = (FStar_Format.text (Prims.strcat "\"" (Prims.strcat file "\""))) -in (_170_417)::[]) -in (_170_419)::_170_418)) -in (_170_421)::_170_420)) -in (FStar_Format.reduce1 _170_422))) +in (FStar_Format.reduce1 (((FStar_Format.text "#"))::((FStar_Format.num lineno))::((FStar_Format.text (Prims.strcat "\"" (Prims.strcat file "\""))))::[]))) end end)) @@ -1252,9 +1128,8 @@ end ( let doc = (FStar_List.map (fun x -> (FStar_Format.text (FStar_Extraction_ML_Syntax.idsym x))) tparams) -in (let _170_431 = (let _170_430 = (FStar_Format.text ", ") -in (FStar_Format.combine _170_430 doc)) -in (FStar_Format.parens _170_431))) +in (let _170_306 = (FStar_Format.combine (FStar_Format.text ", ") doc) +in (FStar_Format.parens _170_306))) end) in ( @@ -1273,15 +1148,11 @@ let name = (FStar_Format.text name) in ( let ty = (doc_of_mltype currentModule ((min_op_prec), (NonAssoc)) ty) -in (let _170_438 = (let _170_437 = (let _170_436 = (FStar_Format.text ":") -in (_170_436)::(ty)::[]) -in (name)::_170_437) -in (FStar_Format.reduce1 _170_438)))) +in (FStar_Format.reduce1 ((name)::((FStar_Format.text ":"))::(ty)::[])))) end)) -in (let _170_441 = (let _170_440 = (FStar_Format.text "; ") -in (let _170_439 = (FStar_List.map forfield fields) -in (FStar_Format.combine _170_440 _170_439))) -in (FStar_Format.cbrackets _170_441))) +in (let _170_312 = (let _170_311 = (FStar_List.map forfield fields) +in (FStar_Format.combine (FStar_Format.text "; ") _170_311)) +in (FStar_Format.cbrackets _170_312))) end | FStar_Extraction_ML_Syntax.MLTD_DType (ctors) -> begin ( @@ -1298,13 +1169,8 @@ end let tys = (FStar_List.map (doc_of_mltype currentModule ((t_prio_tpl), (Left))) tys) in ( -let tys = (let _170_444 = (FStar_Format.text " * ") -in (FStar_Format.combine _170_444 tys)) -in (let _170_448 = (let _170_447 = (FStar_Format.text name) -in (let _170_446 = (let _170_445 = (FStar_Format.text "of") -in (_170_445)::(tys)::[]) -in (_170_447)::_170_446)) -in (FStar_Format.reduce1 _170_448)))) +let tys = (FStar_Format.combine (FStar_Format.text " * ") tys) +in (FStar_Format.reduce1 (((FStar_Format.text name))::((FStar_Format.text "of"))::(tys)::[])))) end) end)) in ( @@ -1312,18 +1178,16 @@ in ( let ctors = (FStar_List.map forctor ctors) in ( -let ctors = (FStar_List.map (fun d -> (let _170_451 = (let _170_450 = (FStar_Format.text "|") -in (_170_450)::(d)::[]) -in (FStar_Format.reduce1 _170_451))) ctors) +let ctors = (FStar_List.map (fun d -> (FStar_Format.reduce1 (((FStar_Format.text "|"))::(d)::[]))) ctors) in (FStar_Format.combine FStar_Format.hardline ctors)))) end)) in ( -let doc = (let _170_455 = (let _170_454 = (let _170_453 = (let _170_452 = (ptsym currentModule (([]), (x))) -in (FStar_Format.text _170_452)) -in (_170_453)::[]) -in (tparams)::_170_454) -in (FStar_Format.reduce1 _170_455)) +let doc = (let _170_319 = (let _170_318 = (let _170_317 = (let _170_316 = (ptsym currentModule (([]), (x))) +in (FStar_Format.text _170_316)) +in (_170_317)::[]) +in (tparams)::_170_318) +in (FStar_Format.reduce1 _170_319)) in (match (body) with | None -> begin doc @@ -1332,12 +1196,9 @@ end ( let body = (forbody body) -in (let _170_460 = (let _170_459 = (let _170_458 = (let _170_457 = (let _170_456 = (FStar_Format.text "=") -in (_170_456)::[]) -in (doc)::_170_457) -in (FStar_Format.reduce1 _170_458)) -in (_170_459)::(body)::[]) -in (FStar_Format.combine FStar_Format.hardline _170_460))) +in (let _170_321 = (let _170_320 = (FStar_Format.reduce1 ((doc)::((FStar_Format.text "="))::[])) +in (_170_320)::(body)::[]) +in (FStar_Format.combine FStar_Format.hardline _170_321))) end))))) end)) in ( @@ -1346,12 +1207,10 @@ let doc = (FStar_List.map for1 decls) in ( let doc = if ((FStar_List.length doc) > (Prims.parse_int "0")) then begin -(let _170_465 = (let _170_464 = (FStar_Format.text "type") -in (let _170_463 = (let _170_462 = (let _170_461 = (FStar_Format.text " \n and ") -in (FStar_Format.combine _170_461 doc)) -in (_170_462)::[]) -in (_170_464)::_170_463)) -in (FStar_Format.reduce1 _170_465)) +(let _170_324 = (let _170_323 = (let _170_322 = (FStar_Format.combine (FStar_Format.text " \n and ") doc) +in (_170_322)::[]) +in ((FStar_Format.text "type"))::_170_323) +in (FStar_Format.reduce1 _170_324)) end else begin (FStar_Format.text "") end @@ -1360,28 +1219,16 @@ in doc)))) let rec doc_of_sig1 : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlsig1 -> FStar_Format.doc = (fun currentModule s -> (match (s) with | FStar_Extraction_ML_Syntax.MLS_Mod (x, subsig) -> begin -(let _170_485 = (let _170_484 = (let _170_477 = (let _170_476 = (FStar_Format.text "module") -in (let _170_475 = (let _170_474 = (FStar_Format.text x) -in (let _170_473 = (let _170_472 = (FStar_Format.text "=") -in (_170_472)::[]) -in (_170_474)::_170_473)) -in (_170_476)::_170_475)) -in (FStar_Format.reduce1 _170_477)) -in (let _170_483 = (let _170_482 = (doc_of_sig currentModule subsig) -in (let _170_481 = (let _170_480 = (let _170_479 = (let _170_478 = (FStar_Format.text "end") -in (_170_478)::[]) -in (FStar_Format.reduce1 _170_479)) -in (_170_480)::[]) -in (_170_482)::_170_481)) -in (_170_484)::_170_483)) -in (FStar_Format.combine FStar_Format.hardline _170_485)) +(let _170_336 = (let _170_335 = (FStar_Format.reduce1 (((FStar_Format.text "module"))::((FStar_Format.text x))::((FStar_Format.text "="))::[])) +in (let _170_334 = (let _170_333 = (doc_of_sig currentModule subsig) +in (let _170_332 = (let _170_331 = (FStar_Format.reduce1 (((FStar_Format.text "end"))::[])) +in (_170_331)::[]) +in (_170_333)::_170_332)) +in (_170_335)::_170_334)) +in (FStar_Format.combine FStar_Format.hardline _170_336)) end | FStar_Extraction_ML_Syntax.MLS_Exn (x, []) -> begin -(let _170_489 = (let _170_488 = (FStar_Format.text "exception") -in (let _170_487 = (let _170_486 = (FStar_Format.text x) -in (_170_486)::[]) -in (_170_488)::_170_487)) -in (FStar_Format.reduce1 _170_489)) +(FStar_Format.reduce1 (((FStar_Format.text "exception"))::((FStar_Format.text x))::[])) end | FStar_Extraction_ML_Syntax.MLS_Exn (x, args) -> begin ( @@ -1389,28 +1236,15 @@ end let args = (FStar_List.map (doc_of_mltype currentModule ((min_op_prec), (NonAssoc))) args) in ( -let args = (let _170_491 = (let _170_490 = (FStar_Format.text " * ") -in (FStar_Format.combine _170_490 args)) -in (FStar_Format.parens _170_491)) -in (let _170_497 = (let _170_496 = (FStar_Format.text "exception") -in (let _170_495 = (let _170_494 = (FStar_Format.text x) -in (let _170_493 = (let _170_492 = (FStar_Format.text "of") -in (_170_492)::(args)::[]) -in (_170_494)::_170_493)) -in (_170_496)::_170_495)) -in (FStar_Format.reduce1 _170_497)))) +let args = (let _170_337 = (FStar_Format.combine (FStar_Format.text " * ") args) +in (FStar_Format.parens _170_337)) +in (FStar_Format.reduce1 (((FStar_Format.text "exception"))::((FStar_Format.text x))::((FStar_Format.text "of"))::(args)::[])))) end | FStar_Extraction_ML_Syntax.MLS_Val (x, (_75_675, ty)) -> begin ( let ty = (doc_of_mltype currentModule ((min_op_prec), (NonAssoc)) ty) -in (let _170_503 = (let _170_502 = (FStar_Format.text "val") -in (let _170_501 = (let _170_500 = (FStar_Format.text x) -in (let _170_499 = (let _170_498 = (FStar_Format.text ": ") -in (_170_498)::(ty)::[]) -in (_170_500)::_170_499)) -in (_170_502)::_170_501)) -in (FStar_Format.reduce1 _170_503))) +in (FStar_Format.reduce1 (((FStar_Format.text "val"))::((FStar_Format.text x))::((FStar_Format.text ": "))::(ty)::[]))) end | FStar_Extraction_ML_Syntax.MLS_Ty (decls) -> begin (doc_of_mltydecl currentModule decls) @@ -1426,11 +1260,7 @@ in (FStar_Format.reduce docs)))) let doc_of_mod1 : FStar_Extraction_ML_Syntax.mlsymbol -> FStar_Extraction_ML_Syntax.mlmodule1 -> FStar_Format.doc = (fun currentModule m -> (match (m) with | FStar_Extraction_ML_Syntax.MLM_Exn (x, []) -> begin -(let _170_514 = (let _170_513 = (FStar_Format.text "exception") -in (let _170_512 = (let _170_511 = (FStar_Format.text x) -in (_170_511)::[]) -in (_170_513)::_170_512)) -in (FStar_Format.reduce1 _170_514)) +(FStar_Format.reduce1 (((FStar_Format.text "exception"))::((FStar_Format.text x))::[])) end | FStar_Extraction_ML_Syntax.MLM_Exn (x, args) -> begin ( @@ -1438,16 +1268,9 @@ end let args = (FStar_List.map (doc_of_mltype currentModule ((min_op_prec), (NonAssoc))) args) in ( -let args = (let _170_516 = (let _170_515 = (FStar_Format.text " * ") -in (FStar_Format.combine _170_515 args)) -in (FStar_Format.parens _170_516)) -in (let _170_522 = (let _170_521 = (FStar_Format.text "exception") -in (let _170_520 = (let _170_519 = (FStar_Format.text x) -in (let _170_518 = (let _170_517 = (FStar_Format.text "of") -in (_170_517)::(args)::[]) -in (_170_519)::_170_518)) -in (_170_521)::_170_520)) -in (FStar_Format.reduce1 _170_522)))) +let args = (let _170_345 = (FStar_Format.combine (FStar_Format.text " * ") args) +in (FStar_Format.parens _170_345)) +in (FStar_Format.reduce1 (((FStar_Format.text "exception"))::((FStar_Format.text x))::((FStar_Format.text "of"))::(args)::[])))) end | FStar_Extraction_ML_Syntax.MLM_Ty (decls) -> begin (doc_of_mltydecl currentModule decls) @@ -1456,15 +1279,12 @@ end (doc_of_lets currentModule ((rec_), (true), (lets))) end | FStar_Extraction_ML_Syntax.MLM_Top (e) -> begin -(let _170_530 = (let _170_529 = (FStar_Format.text "let") -in (let _170_528 = (let _170_527 = (FStar_Format.text "_") -in (let _170_526 = (let _170_525 = (FStar_Format.text "=") -in (let _170_524 = (let _170_523 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) -in (_170_523)::[]) -in (_170_525)::_170_524)) -in (_170_527)::_170_526)) -in (_170_529)::_170_528)) -in (FStar_Format.reduce1 _170_530)) +(let _170_350 = (let _170_349 = (let _170_348 = (let _170_347 = (let _170_346 = (doc_of_expr currentModule ((min_op_prec), (NonAssoc)) e) +in (_170_346)::[]) +in ((FStar_Format.text "="))::_170_347) +in ((FStar_Format.text "_"))::_170_348) +in ((FStar_Format.text "let"))::_170_349) +in (FStar_Format.reduce1 _170_350)) end | FStar_Extraction_ML_Syntax.MLM_Loc (loc) -> begin (doc_of_loc loc) @@ -1497,20 +1317,10 @@ let rec for1_sig = (fun _75_730 -> (match (_75_730) with let x = (FStar_Extraction_ML_Util.flatten_mlpath x) in ( -let head = (let _170_549 = (let _170_548 = (FStar_Format.text "module") -in (let _170_547 = (let _170_546 = (FStar_Format.text x) -in (let _170_545 = (let _170_544 = (FStar_Format.text ":") -in (let _170_543 = (let _170_542 = (FStar_Format.text "sig") -in (_170_542)::[]) -in (_170_544)::_170_543)) -in (_170_546)::_170_545)) -in (_170_548)::_170_547)) -in (FStar_Format.reduce1 _170_549)) +let head = (FStar_Format.reduce1 (((FStar_Format.text "module"))::((FStar_Format.text x))::((FStar_Format.text ":"))::((FStar_Format.text "sig"))::[])) in ( -let tail = (let _170_551 = (let _170_550 = (FStar_Format.text "end") -in (_170_550)::[]) -in (FStar_Format.reduce1 _170_551)) +let tail = (FStar_Format.reduce1 (((FStar_Format.text "end"))::[])) in ( let doc = (FStar_Option.map (fun _75_737 -> (match (_75_737) with @@ -1523,21 +1333,17 @@ let sub = (FStar_List.map for1_sig sub) in ( let sub = (FStar_List.map (fun x -> (FStar_Format.reduce ((x)::(FStar_Format.hardline)::(FStar_Format.hardline)::[]))) sub) -in (let _170_561 = (let _170_560 = (FStar_Format.cat head FStar_Format.hardline) -in (let _170_559 = (let _170_558 = (match (doc) with +in (let _170_367 = (let _170_366 = (let _170_365 = (let _170_364 = (FStar_Format.reduce sub) +in (_170_364)::((FStar_Format.cat tail FStar_Format.hardline))::[]) +in ((match (doc) with | None -> begin FStar_Format.empty end | Some (s) -> begin (FStar_Format.cat s FStar_Format.hardline) -end) -in (let _170_557 = (let _170_556 = (FStar_Format.reduce sub) -in (let _170_555 = (let _170_554 = (FStar_Format.cat tail FStar_Format.hardline) -in (_170_554)::[]) -in (_170_556)::_170_555)) -in (_170_558)::_170_557)) -in (_170_560)::_170_559)) -in (FStar_Format.reduce _170_561)))))))) +end))::_170_365) +in ((FStar_Format.cat head FStar_Format.hardline))::_170_366) +in (FStar_Format.reduce _170_367)))))))) end)) and for1_mod = (fun istop _75_750 -> (match (_75_750) with | (x, sigmod, FStar_Extraction_ML_Syntax.MLLib (sub)) -> begin @@ -1546,32 +1352,20 @@ and for1_mod = (fun istop _75_750 -> (match (_75_750) with let x = (FStar_Extraction_ML_Util.flatten_mlpath x) in ( -let head = (let _170_574 = if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin -(let _170_566 = (FStar_Format.text "module") -in (let _170_565 = (let _170_564 = (FStar_Format.text x) -in (_170_564)::[]) -in (_170_566)::_170_565)) +let head = (let _170_370 = if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin +((FStar_Format.text "module"))::((FStar_Format.text x))::[] end else begin if (not (istop)) then begin -(let _170_573 = (FStar_Format.text "module") -in (let _170_572 = (let _170_571 = (FStar_Format.text x) -in (let _170_570 = (let _170_569 = (FStar_Format.text "=") -in (let _170_568 = (let _170_567 = (FStar_Format.text "struct") -in (_170_567)::[]) -in (_170_569)::_170_568)) -in (_170_571)::_170_570)) -in (_170_573)::_170_572)) +((FStar_Format.text "module"))::((FStar_Format.text x))::((FStar_Format.text "="))::((FStar_Format.text "struct"))::[] end else begin [] end end -in (FStar_Format.reduce1 _170_574)) +in (FStar_Format.reduce1 _170_370)) in ( let tail = if (not (istop)) then begin -(let _170_576 = (let _170_575 = (FStar_Format.text "end") -in (_170_575)::[]) -in (FStar_Format.reduce1 _170_576)) +(FStar_Format.reduce1 (((FStar_Format.text "end"))::[])) end else begin (FStar_Format.reduce1 []) end @@ -1590,39 +1384,33 @@ let sub = (FStar_List.map (fun x -> (FStar_Format.reduce ((x)::(FStar_Format.har in ( let prefix = if (FStar_Extraction_ML_Util.codegen_fsharp ()) then begin -(let _170_580 = (let _170_579 = (FStar_Format.text "#light \"off\"") -in (FStar_Format.cat _170_579 FStar_Format.hardline)) -in (_170_580)::[]) +((FStar_Format.cat (FStar_Format.text "#light \"off\"") FStar_Format.hardline))::[] end else begin [] end -in (let _170_592 = (let _170_591 = (let _170_590 = (let _170_589 = (let _170_588 = (FStar_Format.text "open Prims") -in (let _170_587 = (let _170_586 = (let _170_585 = (match (doc) with +in (let _170_380 = (let _170_379 = (let _170_378 = (let _170_377 = (let _170_376 = (let _170_375 = (let _170_374 = (let _170_373 = (FStar_Format.reduce sub) +in (_170_373)::((FStar_Format.cat tail FStar_Format.hardline))::[]) +in ((match (doc) with | None -> begin FStar_Format.empty end | Some (s) -> begin (FStar_Format.cat s FStar_Format.hardline) -end) -in (let _170_584 = (let _170_583 = (FStar_Format.reduce sub) -in (let _170_582 = (let _170_581 = (FStar_Format.cat tail FStar_Format.hardline) -in (_170_581)::[]) -in (_170_583)::_170_582)) -in (_170_585)::_170_584)) -in (FStar_Format.hardline)::_170_586) -in (_170_588)::_170_587)) -in (FStar_Format.hardline)::_170_589) -in (head)::_170_590) -in (FStar_List.append prefix _170_591)) -in (FStar_All.pipe_left FStar_Format.reduce _170_592))))))))) +end))::_170_374) +in (FStar_Format.hardline)::_170_375) +in ((FStar_Format.text "open Prims"))::_170_376) +in (FStar_Format.hardline)::_170_377) +in (head)::_170_378) +in (FStar_List.append prefix _170_379)) +in (FStar_All.pipe_left FStar_Format.reduce _170_380))))))))) end)) in ( let docs = (FStar_List.map (fun _75_769 -> (match (_75_769) with | (x, s, m) -> begin -(let _170_595 = (FStar_Extraction_ML_Util.flatten_mlpath x) -in (let _170_594 = (for1_mod true ((x), (s), (m))) -in ((_170_595), (_170_594)))) +(let _170_383 = (FStar_Extraction_ML_Util.flatten_mlpath x) +in (let _170_382 = (for1_mod true ((x), (s), (m))) +in ((_170_383), (_170_382)))) end)) mllib) in docs)) end)) @@ -1633,15 +1421,15 @@ let doc_of_mllib : FStar_Extraction_ML_Syntax.mllib -> (Prims.string * FStar_F let string_of_mlexpr : FStar_Extraction_ML_Syntax.mlpath -> FStar_Extraction_ML_Syntax.mlexpr -> Prims.string = (fun cmod e -> ( -let doc = (let _170_602 = (FStar_Extraction_ML_Util.flatten_mlpath cmod) -in (doc_of_expr _170_602 ((min_op_prec), (NonAssoc)) e)) +let doc = (let _170_390 = (FStar_Extraction_ML_Util.flatten_mlpath cmod) +in (doc_of_expr _170_390 ((min_op_prec), (NonAssoc)) e)) in (FStar_Format.pretty (Prims.parse_int "0") doc))) let string_of_mlty : FStar_Extraction_ML_Syntax.mlpath -> FStar_Extraction_ML_Syntax.mlty -> Prims.string = (fun cmod e -> ( -let doc = (let _170_607 = (FStar_Extraction_ML_Util.flatten_mlpath cmod) -in (doc_of_mltype _170_607 ((min_op_prec), (NonAssoc)) e)) +let doc = (let _170_395 = (FStar_Extraction_ML_Util.flatten_mlpath cmod) +in (doc_of_mltype _170_395 ((min_op_prec), (NonAssoc)) e)) in (FStar_Format.pretty (Prims.parse_int "0") doc))) diff --git a/src/ocaml-output/FStar_Extraction_ML_Modul.ml b/src/ocaml-output/FStar_Extraction_ML_Modul.ml index 7abf58c580a..b33088e0754 100755 --- a/src/ocaml-output/FStar_Extraction_ML_Modul.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Modul.ml @@ -18,26 +18,14 @@ in FStar_Syntax_Syntax.Tm_app (_175_15)) in (FStar_Syntax_Syntax.mk _175_16 None FStar_Range.dummyRange))) -let mangle_projector_lid : FStar_Ident.lident -> FStar_Ident.lident = (fun x -> ( - -let projecteeName = x.FStar_Ident.ident -in ( - -let _80_20 = (FStar_Util.prefix x.FStar_Ident.ns) -in (match (_80_20) with -| (prefix, constrName) -> begin -( - -let mangledName = (FStar_Ident.id_of_text (Prims.strcat "___" (Prims.strcat constrName.FStar_Ident.idText (Prims.strcat "___" projecteeName.FStar_Ident.idText)))) -in (FStar_Ident.lid_of_ids (FStar_List.append prefix ((mangledName)::[])))) -end)))) +let mangle_projector_lid : FStar_Ident.lident -> FStar_Ident.lident = (fun x -> x) let lident_as_mlsymbol : FStar_Ident.lident -> Prims.string = (fun id -> id.FStar_Ident.ident.FStar_Ident.idText) -let binders_as_mlty_binders = (fun env bs -> (FStar_Util.fold_map (fun env _80_29 -> (match (_80_29) with -| (bv, _80_28) -> begin +let binders_as_mlty_binders = (fun env bs -> (FStar_Util.fold_map (fun env _80_24 -> (match (_80_24) with +| (bv, _80_23) -> begin (let _175_29 = (let _175_27 = (let _175_26 = (let _175_25 = (FStar_Extraction_ML_UEnv.bv_as_ml_tyvar bv) in FStar_Extraction_ML_Syntax.MLTY_Var (_175_25)) in Some (_175_26)) @@ -58,22 +46,22 @@ in (FStar_All.pipe_right _175_39 FStar_Syntax_Util.un_uinst)) in ( let def = (match (def.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_abs (_80_37) -> begin +| FStar_Syntax_Syntax.Tm_abs (_80_32) -> begin (FStar_Extraction_ML_Term.normalize_abs def) end -| _80_40 -> begin +| _80_35 -> begin def end) in ( -let _80_52 = (match (def.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_abs (bs, body, _80_45) -> begin +let _80_47 = (match (def.FStar_Syntax_Syntax.n) with +| FStar_Syntax_Syntax.Tm_abs (bs, body, _80_40) -> begin (FStar_Syntax_Subst.open_term bs body) end -| _80_49 -> begin +| _80_44 -> begin (([]), (def)) end) -in (match (_80_52) with +in (match (_80_47) with | (bs, body) -> begin ( @@ -81,13 +69,13 @@ let assumed = (FStar_Util.for_some (fun _80_1 -> (match (_80_1) with | FStar_Syntax_Syntax.Assumption -> begin true end -| _80_56 -> begin +| _80_51 -> begin false end)) quals) in ( -let _80_60 = (binders_as_mlty_binders env bs) -in (match (_80_60) with +let _80_55 = (binders_as_mlty_binders env bs) +in (match (_80_55) with | (env, ml_bs) -> begin ( @@ -96,10 +84,10 @@ in (FStar_All.pipe_right _175_41 (FStar_Extraction_ML_Util.eraseTypeDeep (FStar_ in ( let mangled_projector = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _80_2 -> (match (_80_2) with -| FStar_Syntax_Syntax.Projector (_80_64) -> begin +| FStar_Syntax_Syntax.Projector (_80_59) -> begin true end -| _80_67 -> begin +| _80_62 -> begin false end)))) then begin ( @@ -123,7 +111,7 @@ let env = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _80_3 -> (mat | (FStar_Syntax_Syntax.Assumption) | (FStar_Syntax_Syntax.New) -> begin true end -| _80_76 -> begin +| _80_71 -> begin false end)))) then begin env @@ -164,27 +152,27 @@ let bundle_as_inductive_families = (fun env ses quals -> (FStar_All.pipe_right s | FStar_Syntax_Syntax.Sig_inductive_typ (l, _us, bs, t, _mut_i, datas, quals, r) -> begin ( -let _80_105 = (FStar_Syntax_Subst.open_term bs t) -in (match (_80_105) with +let _80_100 = (FStar_Syntax_Subst.open_term bs t) +in (match (_80_100) with | (bs, t) -> begin ( let datas = (FStar_All.pipe_right ses (FStar_List.collect (fun _80_4 -> (match (_80_4) with -| FStar_Syntax_Syntax.Sig_datacon (d, _80_109, t, l', nparams, _80_114, _80_116, _80_118) when (FStar_Ident.lid_equals l l') -> begin +| FStar_Syntax_Syntax.Sig_datacon (d, _80_104, t, l', nparams, _80_109, _80_111, _80_113) when (FStar_Ident.lid_equals l l') -> begin ( -let _80_123 = (FStar_Syntax_Util.arrow_formals t) -in (match (_80_123) with +let _80_118 = (FStar_Syntax_Util.arrow_formals t) +in (match (_80_118) with | (bs', body) -> begin ( -let _80_126 = (FStar_Util.first_N (FStar_List.length bs) bs') -in (match (_80_126) with +let _80_121 = (FStar_Util.first_N (FStar_List.length bs) bs') +in (match (_80_121) with | (bs_params, rest) -> begin ( -let subst = (FStar_List.map2 (fun _80_130 _80_134 -> (match (((_80_130), (_80_134))) with -| ((b', _80_129), (b, _80_133)) -> begin +let subst = (FStar_List.map2 (fun _80_125 _80_129 -> (match (((_80_125), (_80_129))) with +| ((b', _80_124), (b, _80_128)) -> begin (let _175_88 = (let _175_87 = (FStar_Syntax_Syntax.bv_to_name b) in ((b'), (_175_87))) in FStar_Syntax_Syntax.NT (_175_88)) @@ -198,13 +186,13 @@ in ({dname = d; dtyp = t})::[])) end)) end)) end -| _80_138 -> begin +| _80_133 -> begin [] end)))) in ({iname = l; iparams = bs; ityp = t; idatas = datas; iquals = quals})::[]) end)) end -| _80_141 -> begin +| _80_136 -> begin [] end))))) @@ -233,50 +221,50 @@ in ( let extract_one_family = (fun env ind -> ( -let _80_156 = (binders_as_mlty_binders env ind.iparams) -in (match (_80_156) with +let _80_151 = (binders_as_mlty_binders env ind.iparams) +in (match (_80_151) with | (env, vars) -> begin ( -let _80_159 = (FStar_All.pipe_right ind.idatas (FStar_Util.fold_map (extract_ctor vars) env)) -in (match (_80_159) with +let _80_154 = (FStar_All.pipe_right ind.idatas (FStar_Util.fold_map (extract_ctor vars) env)) +in (match (_80_154) with | (env, ctors) -> begin ( -let _80_163 = (FStar_Syntax_Util.arrow_formals ind.ityp) -in (match (_80_163) with -| (indices, _80_162) -> begin +let _80_158 = (FStar_Syntax_Util.arrow_formals ind.ityp) +in (match (_80_158) with +| (indices, _80_157) -> begin ( -let ml_params = (let _175_113 = (FStar_All.pipe_right indices (FStar_List.mapi (fun i _80_165 -> (let _175_112 = (let _175_111 = (FStar_Util.string_of_int i) +let ml_params = (let _175_113 = (FStar_All.pipe_right indices (FStar_List.mapi (fun i _80_160 -> (let _175_112 = (let _175_111 = (FStar_Util.string_of_int i) in (Prims.strcat "\'dummyV" _175_111)) in ((_175_112), ((Prims.parse_int "0"))))))) in (FStar_List.append vars _175_113)) in ( let tbody = (match ((FStar_Util.find_opt (fun _80_6 -> (match (_80_6) with -| FStar_Syntax_Syntax.RecordType (_80_170) -> begin +| FStar_Syntax_Syntax.RecordType (_80_165) -> begin true end -| _80_173 -> begin +| _80_168 -> begin false end)) ind.iquals)) with | Some (FStar_Syntax_Syntax.RecordType (ids)) -> begin ( -let _80_180 = (FStar_List.hd ctors) -in (match (_80_180) with -| (_80_178, c_ty) -> begin +let _80_174 = (FStar_List.hd ctors) +in (match (_80_174) with +| (c_name, c_ty) -> begin ( -let _80_181 = () +let _80_175 = () in ( -let fields = (FStar_List.map2 (fun lid ty -> (((lident_as_mlsymbol lid)), (ty))) ids c_ty) +let fields = (FStar_List.map2 (fun lid ty -> (((FStar_Syntax_Util.mk_field_projector_name_from_string c_name (lident_as_mlsymbol lid))), (ty))) ids c_ty) in FStar_Extraction_ML_Syntax.MLTD_Record (fields))) end)) end -| _80_187 -> begin +| _80_181 -> begin FStar_Extraction_ML_Syntax.MLTD_DType (ctors) end) in ((env), (((false), ((lident_as_mlsymbol ind.iname)), (None), (ml_params), (Some (tbody))))))) @@ -284,28 +272,28 @@ end)) end)) end))) in (match (se) with -| FStar_Syntax_Syntax.Sig_bundle ((FStar_Syntax_Syntax.Sig_datacon (l, _80_191, t, _80_194, _80_196, _80_198, _80_200, _80_202))::[], (FStar_Syntax_Syntax.ExceptionConstructor)::[], _80_209, r) -> begin +| FStar_Syntax_Syntax.Sig_bundle ((FStar_Syntax_Syntax.Sig_datacon (l, _80_185, t, _80_188, _80_190, _80_192, _80_194, _80_196))::[], (FStar_Syntax_Syntax.ExceptionConstructor)::[], _80_203, r) -> begin ( -let _80_215 = (extract_ctor [] env {dname = l; dtyp = t}) -in (match (_80_215) with +let _80_209 = (extract_ctor [] env {dname = l; dtyp = t}) +in (match (_80_209) with | (env, ctor) -> begin ((env), ((FStar_Extraction_ML_Syntax.MLM_Exn (ctor))::[])) end)) end -| FStar_Syntax_Syntax.Sig_bundle (ses, quals, _80_219, r) -> begin +| FStar_Syntax_Syntax.Sig_bundle (ses, quals, _80_213, r) -> begin ( let ifams = (bundle_as_inductive_families env ses quals) in ( -let _80_226 = (FStar_Util.fold_map extract_one_family env ifams) -in (match (_80_226) with +let _80_220 = (FStar_Util.fold_map extract_one_family env ifams) +in (match (_80_220) with | (env, td) -> begin ((env), ((FStar_Extraction_ML_Syntax.MLM_Ty (td))::[])) end))) end -| _80_228 -> begin +| _80_222 -> begin (FStar_All.failwith "Unexpected signature element") end)))) @@ -326,14 +314,14 @@ in (match (se) with | (FStar_Syntax_Syntax.Sig_bundle (_)) | (FStar_Syntax_Syntax.Sig_inductive_typ (_)) | (FStar_Syntax_Syntax.Sig_datacon (_)) -> begin (FStar_Util.print_string "\t\tInductive bundle") end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_247, t, quals, _80_251) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_241, t, quals, _80_245) -> begin (let _175_126 = (FStar_Syntax_Print.lid_to_string lid) in (let _175_125 = (let _175_124 = (let _175_123 = (FStar_Extraction_ML_Term.level g t) in (FStar_All.pipe_left (FStar_Extraction_ML_Term.predecessor t) _175_123)) in (l _175_124)) in (FStar_Util.print2 "\t\t%s @ %s\n" _175_126 _175_125))) end -| FStar_Syntax_Syntax.Sig_let ((_80_255, (lb)::_80_257), _80_262, _80_264, _80_266) -> begin +| FStar_Syntax_Syntax.Sig_let ((_80_249, (lb)::_80_251), _80_256, _80_258, _80_260) -> begin (let _175_134 = (let _175_129 = (let _175_128 = (let _175_127 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) in _175_127.FStar_Syntax_Syntax.fv_name) in _175_128.FStar_Syntax_Syntax.v) @@ -344,16 +332,16 @@ in (FStar_All.pipe_left (FStar_Extraction_ML_Term.predecessor lb.FStar_Syntax_Sy in (l _175_131)) in (FStar_Util.print3 "\t\t%s : %s @ %s\n" _175_134 _175_133 _175_132)))) end -| _80_270 -> begin +| _80_264 -> begin (FStar_Util.print_string "other\n") end))) let rec extract_sig : env_t -> FStar_Syntax_Syntax.sigelt -> (env_t * FStar_Extraction_ML_Syntax.mlmodule1 Prims.list) = (fun g se -> ( -let _80_276 = (FStar_Extraction_ML_UEnv.debug g (fun u -> ( +let _80_270 = (FStar_Extraction_ML_UEnv.debug g (fun u -> ( -let _80_274 = (let _175_141 = (let _175_140 = (FStar_Syntax_Print.sigelt_to_string se) +let _80_268 = (let _175_141 = (let _175_140 = (FStar_Syntax_Print.sigelt_to_string se) in (FStar_Util.format1 ">>>> extract_sig : %s \n" _175_140)) in (FStar_Util.print_string _175_141)) in (level_of_sigelt g se)))) @@ -361,7 +349,7 @@ in (match (se) with | (FStar_Syntax_Syntax.Sig_bundle (_)) | (FStar_Syntax_Syntax.Sig_inductive_typ (_)) | (FStar_Syntax_Syntax.Sig_datacon (_)) -> begin (extract_bundle g se) end -| FStar_Syntax_Syntax.Sig_new_effect (ed, _80_289) when (FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) -> begin +| FStar_Syntax_Syntax.Sig_new_effect (ed, _80_283) when (FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) -> begin ( let extend_env = (fun g lid ml_name tm tysc -> ( @@ -379,7 +367,7 @@ in ( let rec extract_fv = (fun tm -> (match ((let _175_155 = (FStar_Syntax_Subst.compress tm) in _175_155.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_uinst (tm, _80_305) -> begin +| FStar_Syntax_Syntax.Tm_uinst (tm, _80_299) -> begin (extract_fv tm) end | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin @@ -388,85 +376,85 @@ end let mlp = (FStar_Extraction_ML_Syntax.mlpath_of_lident fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) in ( -let _80_316 = (let _175_156 = (FStar_Extraction_ML_UEnv.lookup_fv g fv) +let _80_310 = (let _175_156 = (FStar_Extraction_ML_UEnv.lookup_fv g fv) in (FStar_All.pipe_left FStar_Util.right _175_156)) -in (match (_80_316) with -| (_80_312, tysc, _80_315) -> begin +in (match (_80_310) with +| (_80_306, tysc, _80_309) -> begin (let _175_157 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) (FStar_Extraction_ML_Syntax.MLE_Name (mlp))) in ((_175_157), (tysc))) end))) end -| _80_318 -> begin +| _80_312 -> begin (FStar_All.failwith "Not an fv") end)) in ( let extract_action = (fun g a -> ( -let _80_324 = (extract_fv a.FStar_Syntax_Syntax.action_defn) -in (match (_80_324) with +let _80_318 = (extract_fv a.FStar_Syntax_Syntax.action_defn) +in (match (_80_318) with | (a_tm, ty_sc) -> begin ( -let _80_327 = (FStar_Extraction_ML_UEnv.action_name ed a) -in (match (_80_327) with +let _80_321 = (FStar_Extraction_ML_UEnv.action_name ed a) +in (match (_80_321) with | (a_nm, a_lid) -> begin (extend_env g a_lid a_nm a_tm ty_sc) end)) end))) in ( -let _80_336 = ( +let _80_330 = ( -let _80_330 = (extract_fv (Prims.snd ed.FStar_Syntax_Syntax.return_repr)) -in (match (_80_330) with +let _80_324 = (extract_fv (Prims.snd ed.FStar_Syntax_Syntax.return_repr)) +in (match (_80_324) with | (return_tm, ty_sc) -> begin ( -let _80_333 = (FStar_Extraction_ML_UEnv.monad_op_name ed "return") -in (match (_80_333) with +let _80_327 = (FStar_Extraction_ML_UEnv.monad_op_name ed "return") +in (match (_80_327) with | (return_nm, return_lid) -> begin (extend_env g return_lid return_nm return_tm ty_sc) end)) end)) -in (match (_80_336) with +in (match (_80_330) with | (g, return_decl) -> begin ( -let _80_345 = ( +let _80_339 = ( -let _80_339 = (extract_fv (Prims.snd ed.FStar_Syntax_Syntax.bind_repr)) -in (match (_80_339) with +let _80_333 = (extract_fv (Prims.snd ed.FStar_Syntax_Syntax.bind_repr)) +in (match (_80_333) with | (bind_tm, ty_sc) -> begin ( -let _80_342 = (FStar_Extraction_ML_UEnv.monad_op_name ed "bind") -in (match (_80_342) with +let _80_336 = (FStar_Extraction_ML_UEnv.monad_op_name ed "bind") +in (match (_80_336) with | (bind_nm, bind_lid) -> begin (extend_env g bind_lid bind_nm bind_tm ty_sc) end)) end)) -in (match (_80_345) with +in (match (_80_339) with | (g, bind_decl) -> begin ( -let _80_348 = (FStar_Util.fold_map extract_action g ed.FStar_Syntax_Syntax.actions) -in (match (_80_348) with +let _80_342 = (FStar_Util.fold_map extract_action g ed.FStar_Syntax_Syntax.actions) +in (match (_80_342) with | (g, actions) -> begin ((g), ((FStar_List.append ((return_decl)::(bind_decl)::[]) actions))) end)) end)) end))))) end -| FStar_Syntax_Syntax.Sig_new_effect (_80_350) -> begin +| FStar_Syntax_Syntax.Sig_new_effect (_80_344) -> begin ((g), ([])) end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_354, t, quals, _80_358) when ((FStar_Extraction_ML_Term.level g t) = FStar_Extraction_ML_Term.Kind_level) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_348, t, quals, _80_352) when ((FStar_Extraction_ML_Term.level g t) = FStar_Extraction_ML_Term.Kind_level) -> begin if (let _175_163 = (FStar_All.pipe_right quals (FStar_Util.for_some (fun _80_8 -> (match (_80_8) with | FStar_Syntax_Syntax.Assumption -> begin true end -| _80_364 -> begin +| _80_358 -> begin false end)))) in (FStar_All.pipe_right _175_163 Prims.op_Negation)) then begin @@ -474,9 +462,9 @@ in (FStar_All.pipe_right _175_163 Prims.op_Negation)) then begin end else begin ( -let _80_368 = (FStar_Syntax_Util.arrow_formals t) -in (match (_80_368) with -| (bs, _80_367) -> begin +let _80_362 = (FStar_Syntax_Util.arrow_formals t) +in (match (_80_362) with +| (bs, _80_361) -> begin ( let fv = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant None) @@ -485,25 +473,25 @@ in (extract_typ_abbrev g fv quals _175_164))) end)) end end -| FStar_Syntax_Syntax.Sig_let ((false, (lb)::[]), _80_375, _80_377, quals) when ((FStar_Extraction_ML_Term.level g lb.FStar_Syntax_Syntax.lbtyp) = FStar_Extraction_ML_Term.Kind_level) -> begin +| FStar_Syntax_Syntax.Sig_let ((false, (lb)::[]), _80_369, _80_371, quals) when ((FStar_Extraction_ML_Term.level g lb.FStar_Syntax_Syntax.lbtyp) = FStar_Extraction_ML_Term.Kind_level) -> begin (let _175_165 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) in (extract_typ_abbrev g _175_165 quals lb.FStar_Syntax_Syntax.lbdef)) end -| FStar_Syntax_Syntax.Sig_let (lbs, r, _80_384, quals) -> begin +| FStar_Syntax_Syntax.Sig_let (lbs, r, _80_378, quals) -> begin ( let elet = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_let (((lbs), (FStar_Syntax_Const.exp_false_bool)))) None r) in ( -let _80_394 = (FStar_Extraction_ML_Term.term_as_mlexpr g elet) -in (match (_80_394) with -| (ml_let, _80_391, _80_393) -> begin +let _80_388 = (FStar_Extraction_ML_Term.term_as_mlexpr g elet) +in (match (_80_388) with +| (ml_let, _80_385, _80_387) -> begin (match (ml_let.FStar_Extraction_ML_Syntax.expr) with -| FStar_Extraction_ML_Syntax.MLE_Let ((flavor, _80_397, bindings), _80_401) -> begin +| FStar_Extraction_ML_Syntax.MLE_Let ((flavor, _80_391, bindings), _80_395) -> begin ( -let _80_433 = (FStar_List.fold_left2 (fun _80_406 ml_lb _80_416 -> (match (((_80_406), (_80_416))) with -| ((env, ml_lbs), {FStar_Syntax_Syntax.lbname = lbname; FStar_Syntax_Syntax.lbunivs = _80_414; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _80_411; FStar_Syntax_Syntax.lbdef = _80_409}) -> begin +let _80_427 = (FStar_List.fold_left2 (fun _80_400 ml_lb _80_410 -> (match (((_80_400), (_80_410))) with +| ((env, ml_lbs), {FStar_Syntax_Syntax.lbname = lbname; FStar_Syntax_Syntax.lbunivs = _80_408; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _80_405; FStar_Syntax_Syntax.lbdef = _80_403}) -> begin ( let lb_lid = (let _175_170 = (let _175_169 = (FStar_Util.right lbname) @@ -511,78 +499,77 @@ in _175_169.FStar_Syntax_Syntax.fv_name) in _175_170.FStar_Syntax_Syntax.v) in ( -let _80_430 = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _80_9 -> (match (_80_9) with -| FStar_Syntax_Syntax.Projector (_80_420) -> begin +let _80_424 = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _80_9 -> (match (_80_9) with +| FStar_Syntax_Syntax.Projector (_80_414) -> begin true end -| _80_423 -> begin +| _80_417 -> begin false end)))) then begin ( -let mname = (let _175_172 = (mangle_projector_lid lb_lid) -in (FStar_All.pipe_right _175_172 FStar_Extraction_ML_Syntax.mlpath_of_lident)) +let mname = (FStar_All.pipe_right (mangle_projector_lid lb_lid) FStar_Extraction_ML_Syntax.mlpath_of_lident) in ( -let env = (let _175_174 = (FStar_Util.right lbname) -in (let _175_173 = (FStar_Util.must ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc) -in (FStar_Extraction_ML_UEnv.extend_fv' env _175_174 mname _175_173 ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit false))) +let env = (let _175_173 = (FStar_Util.right lbname) +in (let _175_172 = (FStar_Util.must ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc) +in (FStar_Extraction_ML_UEnv.extend_fv' env _175_173 mname _175_172 ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit false))) in ((env), (( -let _80_426 = ml_lb -in {FStar_Extraction_ML_Syntax.mllb_name = (((Prims.snd mname)), ((Prims.parse_int "0"))); FStar_Extraction_ML_Syntax.mllb_tysc = _80_426.FStar_Extraction_ML_Syntax.mllb_tysc; FStar_Extraction_ML_Syntax.mllb_add_unit = _80_426.FStar_Extraction_ML_Syntax.mllb_add_unit; FStar_Extraction_ML_Syntax.mllb_def = _80_426.FStar_Extraction_ML_Syntax.mllb_def; FStar_Extraction_ML_Syntax.print_typ = _80_426.FStar_Extraction_ML_Syntax.print_typ}))))) +let _80_420 = ml_lb +in {FStar_Extraction_ML_Syntax.mllb_name = (((Prims.snd mname)), ((Prims.parse_int "0"))); FStar_Extraction_ML_Syntax.mllb_tysc = _80_420.FStar_Extraction_ML_Syntax.mllb_tysc; FStar_Extraction_ML_Syntax.mllb_add_unit = _80_420.FStar_Extraction_ML_Syntax.mllb_add_unit; FStar_Extraction_ML_Syntax.mllb_def = _80_420.FStar_Extraction_ML_Syntax.mllb_def; FStar_Extraction_ML_Syntax.print_typ = _80_420.FStar_Extraction_ML_Syntax.print_typ}))))) end else begin -(let _175_177 = (let _175_176 = (let _175_175 = (FStar_Util.must ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc) -in (FStar_Extraction_ML_UEnv.extend_lb env lbname t _175_175 ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit false)) -in (FStar_All.pipe_left Prims.fst _175_176)) -in ((_175_177), (ml_lb))) +(let _175_176 = (let _175_175 = (let _175_174 = (FStar_Util.must ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc) +in (FStar_Extraction_ML_UEnv.extend_lb env lbname t _175_174 ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit false)) +in (FStar_All.pipe_left Prims.fst _175_175)) +in ((_175_176), (ml_lb))) end -in (match (_80_430) with +in (match (_80_424) with | (g, ml_lb) -> begin ((g), ((ml_lb)::ml_lbs)) end))) end)) ((g), ([])) bindings (Prims.snd lbs)) -in (match (_80_433) with +in (match (_80_427) with | (g, ml_lbs') -> begin ( -let flags = (let _175_181 = if (FStar_Util.for_some (fun _80_10 -> (match (_80_10) with +let flags = (let _175_180 = if (FStar_Util.for_some (fun _80_10 -> (match (_80_10) with | FStar_Syntax_Syntax.Assumption -> begin true end -| _80_437 -> begin +| _80_431 -> begin false end)) quals) then begin (FStar_Extraction_ML_Syntax.Assumed)::[] end else begin [] end -in (let _175_180 = if (FStar_Util.for_some (fun _80_11 -> (match (_80_11) with +in (let _175_179 = if (FStar_Util.for_some (fun _80_11 -> (match (_80_11) with | FStar_Syntax_Syntax.Private -> begin true end -| _80_441 -> begin +| _80_435 -> begin false end)) quals) then begin (FStar_Extraction_ML_Syntax.Private)::[] end else begin [] end -in (FStar_List.append _175_181 _175_180))) -in (let _175_184 = (let _175_183 = (let _175_182 = (FStar_Extraction_ML_Util.mlloc_of_range r) -in FStar_Extraction_ML_Syntax.MLM_Loc (_175_182)) -in (_175_183)::(FStar_Extraction_ML_Syntax.MLM_Let (((flavor), (flags), ((FStar_List.rev ml_lbs')))))::[]) -in ((g), (_175_184)))) +in (FStar_List.append _175_180 _175_179))) +in (let _175_183 = (let _175_182 = (let _175_181 = (FStar_Extraction_ML_Util.mlloc_of_range r) +in FStar_Extraction_ML_Syntax.MLM_Loc (_175_181)) +in (_175_182)::(FStar_Extraction_ML_Syntax.MLM_Let (((flavor), (flags), ((FStar_List.rev ml_lbs')))))::[]) +in ((g), (_175_183)))) end)) end -| _80_444 -> begin -(let _175_186 = (let _175_185 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule ml_let) -in (FStar_Util.format1 "Impossible: Translated a let to a non-let: %s" _175_185)) -in (FStar_All.failwith _175_186)) +| _80_438 -> begin +(let _175_185 = (let _175_184 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule ml_let) +in (FStar_Util.format1 "Impossible: Translated a let to a non-let: %s" _175_184)) +in (FStar_All.failwith _175_185)) end) end))) end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_447, t, quals, r) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (lid, _80_441, t, quals, r) -> begin if (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Assumption)) then begin ( @@ -593,48 +580,48 @@ let imp = (match ((FStar_Syntax_Util.arrow_formals t)) with (fail_exp lid t) end | (bs, t) -> begin -(let _175_187 = (fail_exp lid t) -in (FStar_Syntax_Util.abs bs _175_187 None)) +(let _175_186 = (fail_exp lid t) +in (FStar_Syntax_Util.abs bs _175_186 None)) end) -in (let _175_193 = (let _175_192 = (let _175_191 = (let _175_190 = (let _175_189 = (let _175_188 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant None) -in FStar_Util.Inr (_175_188)) -in {FStar_Syntax_Syntax.lbname = _175_189; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_ML_lid; FStar_Syntax_Syntax.lbdef = imp}) -in (_175_190)::[]) -in ((false), (_175_191))) -in ((_175_192), (r), ([]), (quals))) -in FStar_Syntax_Syntax.Sig_let (_175_193))) +in (let _175_192 = (let _175_191 = (let _175_190 = (let _175_189 = (let _175_188 = (let _175_187 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant None) +in FStar_Util.Inr (_175_187)) +in {FStar_Syntax_Syntax.lbname = _175_188; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_ML_lid; FStar_Syntax_Syntax.lbdef = imp}) +in (_175_189)::[]) +in ((false), (_175_190))) +in ((_175_191), (r), ([]), (quals))) +in FStar_Syntax_Syntax.Sig_let (_175_192))) in ( -let _80_463 = (extract_sig g always_fail) -in (match (_80_463) with +let _80_457 = (extract_sig g always_fail) +in (match (_80_457) with | (g, mlm) -> begin (match ((FStar_Util.find_map quals (fun _80_12 -> (match (_80_12) with | FStar_Syntax_Syntax.Discriminator (l) -> begin Some (l) end -| _80_468 -> begin +| _80_462 -> begin None end)))) with | Some (l) -> begin -(let _175_199 = (let _175_198 = (let _175_195 = (FStar_Extraction_ML_Util.mlloc_of_range r) -in FStar_Extraction_ML_Syntax.MLM_Loc (_175_195)) -in (let _175_197 = (let _175_196 = (FStar_Extraction_ML_Term.ind_discriminator_body g lid l) -in (_175_196)::[]) -in (_175_198)::_175_197)) -in ((g), (_175_199))) -end -| _80_472 -> begin +(let _175_198 = (let _175_197 = (let _175_194 = (FStar_Extraction_ML_Util.mlloc_of_range r) +in FStar_Extraction_ML_Syntax.MLM_Loc (_175_194)) +in (let _175_196 = (let _175_195 = (FStar_Extraction_ML_Term.ind_discriminator_body g lid l) +in (_175_195)::[]) +in (_175_197)::_175_196)) +in ((g), (_175_198))) +end +| _80_466 -> begin (match ((FStar_Util.find_map quals (fun _80_13 -> (match (_80_13) with -| FStar_Syntax_Syntax.Projector (l, _80_476) -> begin +| FStar_Syntax_Syntax.Projector (l, _80_470) -> begin Some (l) end -| _80_480 -> begin +| _80_474 -> begin None end)))) with -| Some (_80_482) -> begin +| Some (_80_476) -> begin ((g), ([])) end -| _80_485 -> begin +| _80_479 -> begin ((g), (mlm)) end) end) @@ -646,16 +633,16 @@ end | FStar_Syntax_Syntax.Sig_main (e, r) -> begin ( -let _80_495 = (FStar_Extraction_ML_Term.term_as_mlexpr g e) -in (match (_80_495) with -| (ml_main, _80_492, _80_494) -> begin -(let _175_203 = (let _175_202 = (let _175_201 = (FStar_Extraction_ML_Util.mlloc_of_range r) -in FStar_Extraction_ML_Syntax.MLM_Loc (_175_201)) -in (_175_202)::(FStar_Extraction_ML_Syntax.MLM_Top (ml_main))::[]) -in ((g), (_175_203))) +let _80_489 = (FStar_Extraction_ML_Term.term_as_mlexpr g e) +in (match (_80_489) with +| (ml_main, _80_486, _80_488) -> begin +(let _175_202 = (let _175_201 = (let _175_200 = (FStar_Extraction_ML_Util.mlloc_of_range r) +in FStar_Extraction_ML_Syntax.MLM_Loc (_175_200)) +in (_175_201)::(FStar_Extraction_ML_Syntax.MLM_Top (ml_main))::[]) +in ((g), (_175_202))) end)) end -| FStar_Syntax_Syntax.Sig_new_effect_for_free (_80_497) -> begin +| FStar_Syntax_Syntax.Sig_new_effect_for_free (_80_491) -> begin (FStar_All.failwith "impossible -- removed by tc.fs") end | (FStar_Syntax_Syntax.Sig_assume (_)) | (FStar_Syntax_Syntax.Sig_sub_effect (_)) | (FStar_Syntax_Syntax.Sig_effect_abbrev (_)) | (FStar_Syntax_Syntax.Sig_pragma (_)) -> begin @@ -663,13 +650,13 @@ end end))) -let extract_iface : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.modul -> env_t = (fun g m -> (let _175_208 = (FStar_Util.fold_map extract_sig g m.FStar_Syntax_Syntax.declarations) -in (FStar_All.pipe_right _175_208 Prims.fst))) +let extract_iface : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.modul -> env_t = (fun g m -> (let _175_207 = (FStar_Util.fold_map extract_sig g m.FStar_Syntax_Syntax.declarations) +in (FStar_All.pipe_right _175_207 Prims.fst))) let rec extract : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.modul -> (FStar_Extraction_ML_UEnv.env * FStar_Extraction_ML_Syntax.mllib Prims.list) = (fun g m -> ( -let _80_515 = (FStar_Syntax_Syntax.reset_gensym ()) +let _80_509 = (FStar_Syntax_Syntax.reset_gensym ()) in ( let name = (FStar_Extraction_ML_Syntax.mlpath_of_lident m.FStar_Syntax_Syntax.name) @@ -677,8 +664,8 @@ in ( let g = ( -let _80_518 = g -in {FStar_Extraction_ML_UEnv.tcenv = _80_518.FStar_Extraction_ML_UEnv.tcenv; FStar_Extraction_ML_UEnv.gamma = _80_518.FStar_Extraction_ML_UEnv.gamma; FStar_Extraction_ML_UEnv.tydefs = _80_518.FStar_Extraction_ML_UEnv.tydefs; FStar_Extraction_ML_UEnv.currentModule = name}) +let _80_512 = g +in {FStar_Extraction_ML_UEnv.tcenv = _80_512.FStar_Extraction_ML_UEnv.tcenv; FStar_Extraction_ML_UEnv.gamma = _80_512.FStar_Extraction_ML_UEnv.gamma; FStar_Extraction_ML_UEnv.tydefs = _80_512.FStar_Extraction_ML_UEnv.tydefs; FStar_Extraction_ML_UEnv.currentModule = name}) in if (((m.FStar_Syntax_Syntax.name.FStar_Ident.str = "Prims") || m.FStar_Syntax_Syntax.is_interface) || (FStar_Options.no_extract m.FStar_Syntax_Syntax.name.FStar_Ident.str)) then begin ( @@ -687,12 +674,12 @@ in ((g), ([]))) end else begin ( -let _80_522 = (let _175_213 = (FStar_Syntax_Print.lid_to_string m.FStar_Syntax_Syntax.name) -in (FStar_Util.print1 "Extracting module %s\n" _175_213)) +let _80_516 = (let _175_212 = (FStar_Syntax_Print.lid_to_string m.FStar_Syntax_Syntax.name) +in (FStar_Util.print1 "Extracting module %s\n" _175_212)) in ( -let _80_526 = (FStar_Util.fold_map extract_sig g m.FStar_Syntax_Syntax.declarations) -in (match (_80_526) with +let _80_520 = (FStar_Util.fold_map extract_sig g m.FStar_Syntax_Syntax.declarations) +in (match (_80_520) with | (g, sigs) -> begin ( diff --git a/src/ocaml-output/FStar_Extraction_ML_Term.ml b/src/ocaml-output/FStar_Extraction_ML_Term.ml index 4949fc55951..52a39a42da5 100755 --- a/src/ocaml-output/FStar_Extraction_ML_Term.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Term.ml @@ -25,45 +25,57 @@ let erasableType : FStar_Extraction_ML_UEnv.env -> FStar_Extraction_ML_Syntax. let eraseTypeDeep : FStar_Extraction_ML_UEnv.env -> FStar_Extraction_ML_Syntax.mlty -> FStar_Extraction_ML_Syntax.mlty = (fun g t -> (FStar_Extraction_ML_Util.eraseTypeDeep (FStar_Extraction_ML_Util.udelta_unfold g) t)) +let record_field_path : FStar_Ident.lident Prims.list -> Prims.string Prims.list = (fun _79_1 -> (match (_79_1) with +| (f)::_79_19 -> begin +( + +let ns = f.FStar_Ident.ns +in (FStar_All.pipe_right ns (FStar_List.map (fun id -> id.FStar_Ident.idText)))) +end +| _79_25 -> begin +(FStar_All.failwith "impos") +end)) + + let fail = (fun r msg -> ( -let _79_18 = (let _174_29 = (let _174_28 = (FStar_Range.string_of_range r) -in (FStar_Util.format2 "%s: %s\n" _174_28 msg)) -in (FStar_All.pipe_left FStar_Util.print_string _174_29)) +let _79_28 = (let _174_32 = (let _174_31 = (FStar_Range.string_of_range r) +in (FStar_Util.format2 "%s: %s\n" _174_31 msg)) +in (FStar_All.pipe_left FStar_Util.print_string _174_32)) in (FStar_All.failwith msg))) -let err_uninst = (fun env t _79_24 -> (match (_79_24) with +let err_uninst = (fun env t _79_34 -> (match (_79_34) with | (vars, ty) -> begin -(let _174_37 = (let _174_36 = (FStar_Syntax_Print.term_to_string t) -in (let _174_35 = (let _174_33 = (FStar_All.pipe_right vars (FStar_List.map Prims.fst)) -in (FStar_All.pipe_right _174_33 (FStar_String.concat ", "))) -in (let _174_34 = (FStar_Extraction_ML_Code.string_of_mlty env.FStar_Extraction_ML_UEnv.currentModule ty) -in (FStar_Util.format3 "Variable %s has a polymorphic type (forall %s. %s); expected it to be fully instantiated" _174_36 _174_35 _174_34)))) -in (fail t.FStar_Syntax_Syntax.pos _174_37)) +(let _174_40 = (let _174_39 = (FStar_Syntax_Print.term_to_string t) +in (let _174_38 = (let _174_36 = (FStar_All.pipe_right vars (FStar_List.map Prims.fst)) +in (FStar_All.pipe_right _174_36 (FStar_String.concat ", "))) +in (let _174_37 = (FStar_Extraction_ML_Code.string_of_mlty env.FStar_Extraction_ML_UEnv.currentModule ty) +in (FStar_Util.format3 "Variable %s has a polymorphic type (forall %s. %s); expected it to be fully instantiated" _174_39 _174_38 _174_37)))) +in (fail t.FStar_Syntax_Syntax.pos _174_40)) end)) -let err_ill_typed_application = (fun env t args ty -> (let _174_47 = (let _174_46 = (FStar_Syntax_Print.term_to_string t) -in (let _174_45 = (let _174_43 = (FStar_All.pipe_right args (FStar_List.map (fun _79_32 -> (match (_79_32) with -| (x, _79_31) -> begin +let err_ill_typed_application = (fun env t args ty -> (let _174_50 = (let _174_49 = (FStar_Syntax_Print.term_to_string t) +in (let _174_48 = (let _174_46 = (FStar_All.pipe_right args (FStar_List.map (fun _79_42 -> (match (_79_42) with +| (x, _79_41) -> begin (FStar_Syntax_Print.term_to_string x) end)))) -in (FStar_All.pipe_right _174_43 (FStar_String.concat " "))) -in (let _174_44 = (FStar_Extraction_ML_Code.string_of_mlty env.FStar_Extraction_ML_UEnv.currentModule ty) -in (FStar_Util.format3 "Ill-typed application: application is %s \n remaining args are %s\nml type of head is %s\n" _174_46 _174_45 _174_44)))) -in (fail t.FStar_Syntax_Syntax.pos _174_47))) +in (FStar_All.pipe_right _174_46 (FStar_String.concat " "))) +in (let _174_47 = (FStar_Extraction_ML_Code.string_of_mlty env.FStar_Extraction_ML_UEnv.currentModule ty) +in (FStar_Util.format3 "Ill-typed application: application is %s \n remaining args are %s\nml type of head is %s\n" _174_49 _174_48 _174_47)))) +in (fail t.FStar_Syntax_Syntax.pos _174_50))) -let err_value_restriction = (fun t -> (let _174_51 = (let _174_50 = (FStar_Syntax_Print.tag_of_term t) -in (let _174_49 = (FStar_Syntax_Print.term_to_string t) -in (FStar_Util.format2 "Refusing to generalize because of the value restriction: (%s) %s" _174_50 _174_49))) -in (fail t.FStar_Syntax_Syntax.pos _174_51))) +let err_value_restriction = (fun t -> (let _174_54 = (let _174_53 = (FStar_Syntax_Print.tag_of_term t) +in (let _174_52 = (FStar_Syntax_Print.term_to_string t) +in (FStar_Util.format2 "Refusing to generalize because of the value restriction: (%s) %s" _174_53 _174_52))) +in (fail t.FStar_Syntax_Syntax.pos _174_54))) -let err_unexpected_eff = (fun t f0 f1 -> (let _174_56 = (let _174_55 = (FStar_Syntax_Print.term_to_string t) -in (FStar_Util.format3 "for expression %s, Expected effect %s; got effect %s" _174_55 (FStar_Extraction_ML_Util.eff_to_string f0) (FStar_Extraction_ML_Util.eff_to_string f1))) -in (fail t.FStar_Syntax_Syntax.pos _174_56))) +let err_unexpected_eff = (fun t f0 f1 -> (let _174_59 = (let _174_58 = (FStar_Syntax_Print.term_to_string t) +in (FStar_Util.format3 "for expression %s, Expected effect %s; got effect %s" _174_58 (FStar_Extraction_ML_Util.eff_to_string f0) (FStar_Extraction_ML_Util.eff_to_string f1))) +in (fail t.FStar_Syntax_Syntax.pos _174_59))) let effect_as_etag : FStar_Extraction_ML_UEnv.env -> FStar_Ident.lident -> FStar_Extraction_ML_Syntax.e_tag = ( @@ -82,12 +94,12 @@ let res = (match ((FStar_TypeChecker_Env.lookup_effect_abbrev g.FStar_Extraction | None -> begin l end -| Some (_79_46, c) -> begin +| Some (_79_56, c) -> begin (delta_norm_eff g (FStar_Syntax_Util.comp_effect_name c)) end) in ( -let _79_51 = (FStar_Util.smap_add cache l.FStar_Ident.str res) +let _79_61 = (FStar_Util.smap_add cache l.FStar_Ident.str res) in res)) end)) in (fun g l -> ( @@ -137,7 +149,7 @@ false end)) -let predecessor = (fun t _79_1 -> (match (_79_1) with +let predecessor = (fun t _79_2 -> (match (_79_2) with | Term_level -> begin Term_level end @@ -157,32 +169,32 @@ in ( let t = (FStar_Syntax_Subst.compress t) in ( -let _79_68 = (FStar_Extraction_ML_UEnv.debug env (fun _79_66 -> (let _174_78 = (FStar_Syntax_Print.term_to_string t) -in (let _174_77 = (FStar_Syntax_Print.tag_of_term t) -in (FStar_Util.print2 "level %s (%s)\n" _174_78 _174_77))))) +let _79_78 = (FStar_Extraction_ML_UEnv.debug env (fun _79_76 -> (let _174_81 = (FStar_Syntax_Print.term_to_string t) +in (let _174_80 = (FStar_Syntax_Print.tag_of_term t) +in (FStar_Util.print2 "level %s (%s)\n" _174_81 _174_80))))) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_delayed (_79_71) -> begin -(let _174_83 = (let _174_82 = (FStar_Syntax_Print.tag_of_term t) -in (FStar_Util.format1 "Impossible: %s" _174_82)) -in (FStar_All.failwith _174_83)) +| FStar_Syntax_Syntax.Tm_delayed (_79_81) -> begin +(let _174_86 = (let _174_85 = (FStar_Syntax_Print.tag_of_term t) +in (FStar_Util.format1 "Impossible: %s" _174_85)) +in (FStar_All.failwith _174_86)) end | FStar_Syntax_Syntax.Tm_unknown -> begin Kind_level end -| FStar_Syntax_Syntax.Tm_constant (_79_75) -> begin +| FStar_Syntax_Syntax.Tm_constant (_79_85) -> begin Term_level end -| FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = _79_83; FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_defined_at_level (_79_80); FStar_Syntax_Syntax.fv_qual = _79_78}) -> begin +| FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = _79_93; FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_defined_at_level (_79_90); FStar_Syntax_Syntax.fv_qual = _79_88}) -> begin ( let t' = (FStar_TypeChecker_Normalize.normalize ((FStar_TypeChecker_Normalize.Beta)::(FStar_TypeChecker_Normalize.UnfoldUntil (FStar_Syntax_Syntax.Delta_constant))::(FStar_TypeChecker_Normalize.EraseUniverses)::(FStar_TypeChecker_Normalize.AllowUnboundUniverses)::(FStar_TypeChecker_Normalize.Exclude (FStar_TypeChecker_Normalize.Zeta))::(FStar_TypeChecker_Normalize.Exclude (FStar_TypeChecker_Normalize.Iota))::[]) env.FStar_Extraction_ML_UEnv.tcenv t) in ( -let _79_88 = (FStar_Extraction_ML_UEnv.debug env (fun _79_87 -> (match (()) with +let _79_98 = (FStar_Extraction_ML_UEnv.debug env (fun _79_97 -> (match (()) with | () -> begin -(let _174_86 = (FStar_Syntax_Print.term_to_string t) -in (let _174_85 = (FStar_Syntax_Print.term_to_string t') -in (FStar_Util.print2 "Normalized %s to %s\n" _174_86 _174_85))) +(let _174_89 = (FStar_Syntax_Print.term_to_string t) +in (let _174_88 = (FStar_Syntax_Print.term_to_string t') +in (FStar_Util.print2 "Normalized %s to %s\n" _174_89 _174_88))) end))) in (level env t'))) end @@ -190,24 +202,24 @@ end if (FStar_TypeChecker_Env.is_type_constructor env.FStar_Extraction_ML_UEnv.tcenv fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) then begin Type_level end else begin -(let _174_87 = (level env fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.ty) -in (FStar_All.pipe_left predecessor _174_87)) +(let _174_90 = (level env fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.ty) +in (FStar_All.pipe_left predecessor _174_90)) end end | (FStar_Syntax_Syntax.Tm_uvar (_, t)) | (FStar_Syntax_Syntax.Tm_bvar ({FStar_Syntax_Syntax.ppname = _; FStar_Syntax_Syntax.index = _; FStar_Syntax_Syntax.sort = t})) | (FStar_Syntax_Syntax.Tm_name ({FStar_Syntax_Syntax.ppname = _; FStar_Syntax_Syntax.index = _; FStar_Syntax_Syntax.sort = t})) -> begin -(let _174_88 = (level env t) -in (FStar_All.pipe_left predecessor _174_88)) +(let _174_91 = (level env t) +in (FStar_All.pipe_left predecessor _174_91)) end -| FStar_Syntax_Syntax.Tm_ascribed (t, _79_111, _79_113) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (t, _79_121, _79_123) -> begin (level env t) end -| FStar_Syntax_Syntax.Tm_type (_79_117) -> begin +| FStar_Syntax_Syntax.Tm_type (_79_127) -> begin Kind_level end -| FStar_Syntax_Syntax.Tm_uinst (t, _79_121) -> begin +| FStar_Syntax_Syntax.Tm_uinst (t, _79_131) -> begin (level env t) end -| FStar_Syntax_Syntax.Tm_refine (x, _79_126) -> begin +| FStar_Syntax_Syntax.Tm_refine (x, _79_136) -> begin (match ((level env x.FStar_Syntax_Syntax.sort)) with | Term_level -> begin Type_level @@ -225,25 +237,25 @@ end l end) end -| FStar_Syntax_Syntax.Tm_abs (bs, body, _79_140) -> begin +| FStar_Syntax_Syntax.Tm_abs (bs, body, _79_150) -> begin (level env body) end -| FStar_Syntax_Syntax.Tm_let (_79_144, body) -> begin +| FStar_Syntax_Syntax.Tm_let (_79_154, body) -> begin (level env body) end -| FStar_Syntax_Syntax.Tm_match (_79_149, branches) -> begin +| FStar_Syntax_Syntax.Tm_match (_79_159, branches) -> begin (match (branches) with -| ((_79_156, _79_158, e))::_79_154 -> begin +| ((_79_166, _79_168, e))::_79_164 -> begin (level env e) end -| _79_163 -> begin +| _79_173 -> begin (FStar_All.failwith "Empty branches") end) end -| FStar_Syntax_Syntax.Tm_meta (t, _79_166) -> begin +| FStar_Syntax_Syntax.Tm_meta (t, _79_176) -> begin (level env t) end -| FStar_Syntax_Syntax.Tm_app (head, _79_171) -> begin +| FStar_Syntax_Syntax.Tm_app (head, _79_181) -> begin (level env head) end))))) @@ -252,7 +264,7 @@ let is_type : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> Pr | Term_level -> begin false end -| _79_178 -> begin +| _79_188 -> begin true end)) @@ -269,25 +281,25 @@ true end)) -let is_constructor : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _174_97 = (FStar_Syntax_Subst.compress t) -in _174_97.FStar_Syntax_Syntax.n)) with +let is_constructor : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _174_100 = (FStar_Syntax_Subst.compress t) +in _174_100.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = _; FStar_Syntax_Syntax.fv_delta = _; FStar_Syntax_Syntax.fv_qual = Some (FStar_Syntax_Syntax.Data_ctor)})) | (FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = _; FStar_Syntax_Syntax.fv_delta = _; FStar_Syntax_Syntax.fv_qual = Some (FStar_Syntax_Syntax.Record_ctor (_))})) -> begin true end -| _79_204 -> begin +| _79_214 -> begin false end)) -let rec is_fstar_value : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _174_100 = (FStar_Syntax_Subst.compress t) -in _174_100.FStar_Syntax_Syntax.n)) with +let rec is_fstar_value : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _174_103 = (FStar_Syntax_Subst.compress t) +in _174_103.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Tm_constant (_)) | (FStar_Syntax_Syntax.Tm_bvar (_)) | (FStar_Syntax_Syntax.Tm_fvar (_)) | (FStar_Syntax_Syntax.Tm_abs (_)) -> begin true end | FStar_Syntax_Syntax.Tm_app (head, args) -> begin if (is_constructor head) then begin -(FStar_All.pipe_right args (FStar_List.for_all (fun _79_225 -> (match (_79_225) with -| (te, _79_224) -> begin +(FStar_All.pipe_right args (FStar_List.for_all (fun _79_235 -> (match (_79_235) with +| (te, _79_234) -> begin (is_fstar_value te) end)))) end else begin @@ -297,7 +309,7 @@ end | (FStar_Syntax_Syntax.Tm_meta (t, _)) | (FStar_Syntax_Syntax.Tm_ascribed (t, _, _)) -> begin (is_fstar_value t) end -| _79_238 -> begin +| _79_248 -> begin false end)) @@ -309,13 +321,13 @@ end | (FStar_Extraction_ML_Syntax.MLE_CTor (_, exps)) | (FStar_Extraction_ML_Syntax.MLE_Tuple (exps)) -> begin (FStar_Util.for_all is_ml_value exps) end -| FStar_Extraction_ML_Syntax.MLE_Record (_79_259, fields) -> begin -(FStar_Util.for_all (fun _79_266 -> (match (_79_266) with -| (_79_264, e) -> begin +| FStar_Extraction_ML_Syntax.MLE_Record (_79_269, fields) -> begin +(FStar_Util.for_all (fun _79_276 -> (match (_79_276) with +| (_79_274, e) -> begin (is_ml_value e) end)) fields) end -| _79_268 -> begin +| _79_278 -> begin false end)) @@ -329,7 +341,7 @@ in (match (t.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_abs (bs', body, copt) -> begin (aux (FStar_List.append bs bs') body copt) end -| _79_281 -> begin +| _79_291 -> begin ( let e' = (FStar_Syntax_Util.unascribe t) @@ -342,8 +354,8 @@ end))) in (aux [] t0 None))) -let unit_binder : FStar_Syntax_Syntax.binder = (let _174_113 = (FStar_Syntax_Syntax.new_bv None FStar_TypeChecker_Common.t_unit) -in (FStar_All.pipe_left FStar_Syntax_Syntax.mk_binder _174_113)) +let unit_binder : FStar_Syntax_Syntax.binder = (let _174_116 = (FStar_Syntax_Syntax.new_bv None FStar_TypeChecker_Common.t_unit) +in (FStar_All.pipe_left FStar_Syntax_Syntax.mk_binder _174_116)) let check_pats_for_ite : (FStar_Syntax_Syntax.pat * FStar_Syntax_Syntax.term Prims.option * FStar_Syntax_Syntax.term) Prims.list -> (Prims.bool * FStar_Syntax_Syntax.term Prims.option * FStar_Syntax_Syntax.term Prims.option) = (fun l -> ( @@ -354,14 +366,14 @@ def end else begin ( -let _79_288 = (FStar_List.hd l) -in (match (_79_288) with +let _79_298 = (FStar_List.hd l) +in (match (_79_298) with | (p1, w1, e1) -> begin ( -let _79_292 = (let _174_116 = (FStar_List.tl l) -in (FStar_List.hd _174_116)) -in (match (_79_292) with +let _79_302 = (let _174_119 = (FStar_List.tl l) +in (FStar_List.hd _174_119)) +in (match (_79_302) with | (p2, w2, e2) -> begin (match (((w1), (w2), (p1.FStar_Syntax_Syntax.v), (p2.FStar_Syntax_Syntax.v))) with | (None, None, FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true)), FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (false))) -> begin @@ -370,7 +382,7 @@ end | (None, None, FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (false)), FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true))) -> begin ((true), (Some (e2)), (Some (e1))) end -| _79_312 -> begin +| _79_322 -> begin def end) end)) @@ -405,25 +417,25 @@ in (match ((type_leq_c g (Some (e)) ty expect)) with | (true, Some (e')) -> begin e' end -| _79_333 -> begin +| _79_343 -> begin ( -let _79_335 = (FStar_Extraction_ML_UEnv.debug g (fun _79_334 -> (match (()) with +let _79_345 = (FStar_Extraction_ML_UEnv.debug g (fun _79_344 -> (match (()) with | () -> begin -(let _174_146 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule e) -in (let _174_145 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule ty) -in (let _174_144 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule expect) -in (FStar_Util.print3 "\n (*needed to coerce expression \n %s \n of type \n %s \n to type \n %s *) \n" _174_146 _174_145 _174_144)))) +(let _174_149 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule e) +in (let _174_148 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule ty) +in (let _174_147 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule expect) +in (FStar_Util.print3 "\n (*needed to coerce expression \n %s \n of type \n %s \n to type \n %s *) \n" _174_149 _174_148 _174_147)))) end))) in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty expect) (FStar_Extraction_ML_Syntax.MLE_Coerce (((e), (ty), (expect)))))) end))) let bv_as_mlty : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.bv -> FStar_Extraction_ML_Syntax.mlty = (fun g bv -> (match ((FStar_Extraction_ML_UEnv.lookup_bv g bv)) with -| FStar_Util.Inl (_79_340, t) -> begin +| FStar_Util.Inl (_79_350, t) -> begin t end -| _79_345 -> begin +| _79_355 -> begin FStar_Extraction_ML_Syntax.MLTY_Top end)) @@ -434,7 +446,7 @@ let rec is_top_ty = (fun t -> (match (t) with | FStar_Extraction_ML_Syntax.MLTY_Top -> begin true end -| FStar_Extraction_ML_Syntax.MLTY_Named (_79_352) -> begin +| FStar_Extraction_ML_Syntax.MLTY_Named (_79_362) -> begin (match ((FStar_Extraction_ML_Util.udelta_unfold g t)) with | None -> begin false @@ -443,7 +455,7 @@ end (is_top_ty t) end) end -| _79_358 -> begin +| _79_368 -> begin false end)) in ( @@ -465,14 +477,14 @@ and term_as_mlty' : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_bvar (_)) | (FStar_Syntax_Syntax.Tm_delayed (_)) | (FStar_Syntax_Syntax.Tm_unknown) -> begin -(let _174_169 = (let _174_168 = (FStar_Syntax_Print.term_to_string t) -in (FStar_Util.format1 "Impossible: Unexpected term %s" _174_168)) -in (FStar_All.failwith _174_169)) +(let _174_172 = (let _174_171 = (FStar_Syntax_Print.term_to_string t) +in (FStar_Util.format1 "Impossible: Unexpected term %s" _174_171)) +in (FStar_All.failwith _174_172)) end -| FStar_Syntax_Syntax.Tm_constant (_79_373) -> begin +| FStar_Syntax_Syntax.Tm_constant (_79_383) -> begin FStar_Extraction_ML_UEnv.unknownType end -| FStar_Syntax_Syntax.Tm_uvar (_79_376) -> begin +| FStar_Syntax_Syntax.Tm_uvar (_79_386) -> begin FStar_Extraction_ML_UEnv.unknownType end | (FStar_Syntax_Syntax.Tm_meta (t, _)) | (FStar_Syntax_Syntax.Tm_refine ({FStar_Syntax_Syntax.ppname = _; FStar_Syntax_Syntax.index = _; FStar_Syntax_Syntax.sort = t}, _)) | (FStar_Syntax_Syntax.Tm_uinst (t, _)) | (FStar_Syntax_Syntax.Tm_ascribed (t, _, _)) -> begin @@ -487,13 +499,13 @@ end | FStar_Syntax_Syntax.Tm_arrow (bs, c) -> begin ( -let _79_412 = (FStar_Syntax_Subst.open_comp bs c) -in (match (_79_412) with +let _79_422 = (FStar_Syntax_Subst.open_comp bs c) +in (match (_79_422) with | (bs, c) -> begin ( -let _79_415 = (binders_as_ml_binders env bs) -in (match (_79_415) with +let _79_425 = (binders_as_ml_binders env bs) +in (match (_79_425) with | (mlbs, env) -> begin ( @@ -519,12 +531,12 @@ in ( let erase = (effect_as_etag env (FStar_Syntax_Util.comp_effect_name c)) in ( -let _79_432 = (FStar_List.fold_right (fun _79_425 _79_428 -> (match (((_79_425), (_79_428))) with -| ((_79_423, t), (tag, t')) -> begin +let _79_442 = (FStar_List.fold_right (fun _79_435 _79_438 -> (match (((_79_435), (_79_438))) with +| ((_79_433, t), (tag, t')) -> begin ((FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.MLTY_Fun (((t), (tag), (t'))))) end)) mlbs ((erase), (t_ret))) -in (match (_79_432) with -| (_79_430, t) -> begin +in (match (_79_442) with +| (_79_440, t) -> begin t end)))) end)) @@ -533,8 +545,8 @@ end | FStar_Syntax_Syntax.Tm_app (head, args) -> begin ( -let res = (match ((let _174_172 = (FStar_Syntax_Util.un_uinst head) -in _174_172.FStar_Syntax_Syntax.n)) with +let res = (match ((let _174_175 = (FStar_Syntax_Util.un_uinst head) +in _174_175.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_name (bv) -> begin (bv_as_mlty env bv) end @@ -542,24 +554,24 @@ end (fv_app_as_mlty env fv args) end | FStar_Syntax_Syntax.Tm_app (head, args') -> begin -(let _174_173 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (((head), ((FStar_List.append args' args))))) None t.FStar_Syntax_Syntax.pos) -in (term_as_mlty' env _174_173)) +(let _174_176 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (((head), ((FStar_List.append args' args))))) None t.FStar_Syntax_Syntax.pos) +in (term_as_mlty' env _174_176)) end -| _79_446 -> begin +| _79_456 -> begin FStar_Extraction_ML_UEnv.unknownType end) in res) end -| FStar_Syntax_Syntax.Tm_abs (bs, ty, _79_451) -> begin +| FStar_Syntax_Syntax.Tm_abs (bs, ty, _79_461) -> begin ( -let _79_456 = (FStar_Syntax_Subst.open_term bs ty) -in (match (_79_456) with +let _79_466 = (FStar_Syntax_Subst.open_term bs ty) +in (match (_79_466) with | (bs, ty) -> begin ( -let _79_459 = (binders_as_ml_binders env bs) -in (match (_79_459) with +let _79_469 = (binders_as_ml_binders env bs) +in (match (_79_469) with | (bts, env) -> begin (term_as_mlty' env ty) end)) @@ -568,8 +580,8 @@ end | (FStar_Syntax_Syntax.Tm_type (_)) | (FStar_Syntax_Syntax.Tm_let (_)) | (FStar_Syntax_Syntax.Tm_match (_)) -> begin FStar_Extraction_ML_UEnv.unknownType end))) -and arg_as_mlty : FStar_Extraction_ML_UEnv.env -> (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) -> FStar_Extraction_ML_Syntax.mlty = (fun g _79_473 -> (match (_79_473) with -| (a, _79_472) -> begin +and arg_as_mlty : FStar_Extraction_ML_UEnv.env -> (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) -> FStar_Extraction_ML_Syntax.mlty = (fun g _79_483 -> (match (_79_483) with +| (a, _79_482) -> begin if (is_type g a) then begin (term_as_mlty' g a) end else begin @@ -578,8 +590,8 @@ end end)) and fv_app_as_mlty : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.args -> FStar_Extraction_ML_Syntax.mlty = (fun g fv args -> ( -let _79_479 = (FStar_Syntax_Util.arrow_formals fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.ty) -in (match (_79_479) with +let _79_489 = (FStar_Syntax_Util.arrow_formals fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.ty) +in (match (_79_489) with | (formals, t) -> begin ( @@ -592,11 +604,11 @@ let n_args = (FStar_List.length args) in if ((FStar_List.length formals) > n_args) then begin ( -let _79_485 = (FStar_Util.first_N n_args formals) -in (match (_79_485) with -| (_79_483, rest) -> begin -(let _174_180 = (FStar_List.map (fun _79_486 -> FStar_Extraction_ML_UEnv.erasedContent) rest) -in (FStar_List.append mlargs _174_180)) +let _79_495 = (FStar_Util.first_N n_args formals) +in (match (_79_495) with +| (_79_493, rest) -> begin +(let _174_183 = (FStar_List.map (fun _79_496 -> FStar_Extraction_ML_UEnv.erasedContent) rest) +in (FStar_List.append mlargs _174_183)) end)) end else begin mlargs @@ -614,7 +626,7 @@ in FStar_Extraction_ML_Syntax.MLTY_Named (((mlargs), (nm)))))) end))) and binders_as_ml_binders : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.binders -> ((FStar_Extraction_ML_Syntax.mlident * FStar_Extraction_ML_Syntax.mlty) Prims.list * FStar_Extraction_ML_UEnv.env) = (fun g bs -> ( -let _79_508 = (FStar_All.pipe_right bs (FStar_List.fold_left (fun _79_497 b -> (match (_79_497) with +let _79_518 = (FStar_All.pipe_right bs (FStar_List.fold_left (fun _79_507 b -> (match (_79_507) with | (ml_bs, env) -> begin if (is_type_binder g b) then begin ( @@ -625,8 +637,8 @@ in ( let env = (FStar_Extraction_ML_UEnv.extend_ty env b (Some (FStar_Extraction_ML_Syntax.MLTY_Top))) in ( -let ml_b = (let _174_185 = (FStar_Extraction_ML_UEnv.bv_as_ml_termvar b) -in ((_174_185), (FStar_Extraction_ML_Syntax.ml_unit_ty))) +let ml_b = (let _174_188 = (FStar_Extraction_ML_UEnv.bv_as_ml_termvar b) +in ((_174_188), (FStar_Extraction_ML_Syntax.ml_unit_ty))) in (((ml_b)::ml_bs), (env))))) end else begin ( @@ -640,12 +652,12 @@ in ( let env = (FStar_Extraction_ML_UEnv.extend_bv env b (([]), (t)) false false false) in ( -let ml_b = (let _174_186 = (FStar_Extraction_ML_UEnv.bv_as_ml_termvar b) -in ((_174_186), (t))) +let ml_b = (let _174_189 = (FStar_Extraction_ML_UEnv.bv_as_ml_termvar b) +in ((_174_189), (t))) in (((ml_b)::ml_bs), (env)))))) end end)) (([]), (g)))) -in (match (_79_508) with +in (match (_79_518) with | (ml_bs, env) -> begin (((FStar_List.rev ml_bs)), (env)) end))) @@ -655,13 +667,13 @@ let mk_MLE_Seq : FStar_Extraction_ML_Syntax.mlexpr -> FStar_Extraction_ML_Synt | (FStar_Extraction_ML_Syntax.MLE_Seq (es1), FStar_Extraction_ML_Syntax.MLE_Seq (es2)) -> begin FStar_Extraction_ML_Syntax.MLE_Seq ((FStar_List.append es1 es2)) end -| (FStar_Extraction_ML_Syntax.MLE_Seq (es1), _79_519) -> begin +| (FStar_Extraction_ML_Syntax.MLE_Seq (es1), _79_529) -> begin FStar_Extraction_ML_Syntax.MLE_Seq ((FStar_List.append es1 ((e2)::[]))) end -| (_79_522, FStar_Extraction_ML_Syntax.MLE_Seq (es2)) -> begin +| (_79_532, FStar_Extraction_ML_Syntax.MLE_Seq (es2)) -> begin FStar_Extraction_ML_Syntax.MLE_Seq ((e1)::es2) end -| _79_527 -> begin +| _79_537 -> begin FStar_Extraction_ML_Syntax.MLE_Seq ((e1)::(e2)::[]) end)) @@ -677,19 +689,19 @@ end else begin | FStar_Extraction_ML_Syntax.MLE_Var (x) when (x = lb.FStar_Extraction_ML_Syntax.mllb_name) -> begin lb.FStar_Extraction_ML_Syntax.mllb_def.FStar_Extraction_ML_Syntax.expr end -| _79_543 when (lb.FStar_Extraction_ML_Syntax.mllb_def.FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.ml_unit.FStar_Extraction_ML_Syntax.expr) -> begin +| _79_553 when (lb.FStar_Extraction_ML_Syntax.mllb_def.FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.ml_unit.FStar_Extraction_ML_Syntax.expr) -> begin body.FStar_Extraction_ML_Syntax.expr end -| _79_545 -> begin +| _79_555 -> begin (mk_MLE_Seq lb.FStar_Extraction_ML_Syntax.mllb_def body) end) end end -| _79_547 -> begin +| _79_557 -> begin FStar_Extraction_ML_Syntax.MLE_Let (((lbs), (body))) end) end -| _79_549 -> begin +| _79_559 -> begin FStar_Extraction_ML_Syntax.MLE_Let (((lbs), (body))) end)) @@ -700,23 +712,23 @@ let resugar_pat : FStar_Syntax_Syntax.fv_qual Prims.option -> FStar_Extraction | Some (n) -> begin FStar_Extraction_ML_Syntax.MLP_Tuple (pats) end -| _79_559 -> begin +| _79_569 -> begin (match (q) with -| Some (FStar_Syntax_Syntax.Record_ctor (_79_561, fns)) -> begin +| Some (FStar_Syntax_Syntax.Record_ctor (_79_571, fns)) -> begin ( -let p = (FStar_Extraction_ML_Util.record_field_path fns) +let p = (record_field_path fns) in ( let fs = (FStar_Extraction_ML_Util.record_fields fns pats) in FStar_Extraction_ML_Syntax.MLP_Record (((p), (fs))))) end -| _79_569 -> begin +| _79_579 -> begin p end) end) end -| _79_571 -> begin +| _79_581 -> begin p end)) @@ -735,17 +747,17 @@ end let ok = (type_leq g t t') in ( -let _79_589 = if (not (ok)) then begin -(FStar_Extraction_ML_UEnv.debug g (fun _79_587 -> (let _174_221 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t') -in (let _174_220 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t) -in (FStar_Util.print2 "Expected pattern type %s; got pattern type %s\n" _174_221 _174_220))))) +let _79_599 = if (not (ok)) then begin +(FStar_Extraction_ML_UEnv.debug g (fun _79_597 -> (let _174_224 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t') +in (let _174_223 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t) +in (FStar_Util.print2 "Expected pattern type %s; got pattern type %s\n" _174_224 _174_223))))) end else begin () end in ok)) end)) in (match (p.FStar_Syntax_Syntax.v) with -| FStar_Syntax_Syntax.Pat_disj (_79_592) -> begin +| FStar_Syntax_Syntax.Pat_disj (_79_602) -> begin (FStar_All.failwith "Impossible: Nested disjunctive pattern") end | FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_int (c, None)) -> begin @@ -757,17 +769,17 @@ in ( let x = (FStar_Extraction_ML_Syntax.gensym ()) in ( -let when_clause = (let _174_230 = (let _174_229 = (let _174_228 = (let _174_227 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_int_ty) (FStar_Extraction_ML_Syntax.MLE_Var (x))) -in (let _174_226 = (let _174_225 = (let _174_224 = (let _174_223 = (FStar_Extraction_ML_Util.mlconst_of_const' p.FStar_Syntax_Syntax.p i) -in (FStar_All.pipe_left (fun _174_222 -> FStar_Extraction_ML_Syntax.MLE_Const (_174_222)) _174_223)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_int_ty) _174_224)) -in (_174_225)::[]) -in (_174_227)::_174_226)) -in ((FStar_Extraction_ML_Util.prims_op_equality), (_174_228))) -in FStar_Extraction_ML_Syntax.MLE_App (_174_229)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) _174_230)) -in (let _174_231 = (ok FStar_Extraction_ML_Syntax.ml_int_ty) -in ((g), (Some (((FStar_Extraction_ML_Syntax.MLP_Var (x)), ((when_clause)::[])))), (_174_231)))))) +let when_clause = (let _174_233 = (let _174_232 = (let _174_231 = (let _174_230 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_int_ty) (FStar_Extraction_ML_Syntax.MLE_Var (x))) +in (let _174_229 = (let _174_228 = (let _174_227 = (let _174_226 = (FStar_Extraction_ML_Util.mlconst_of_const' p.FStar_Syntax_Syntax.p i) +in (FStar_All.pipe_left (fun _174_225 -> FStar_Extraction_ML_Syntax.MLE_Const (_174_225)) _174_226)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_int_ty) _174_227)) +in (_174_228)::[]) +in (_174_230)::_174_229)) +in ((FStar_Extraction_ML_Util.prims_op_equality), (_174_231))) +in FStar_Extraction_ML_Syntax.MLE_App (_174_232)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) _174_233)) +in (let _174_234 = (ok FStar_Extraction_ML_Syntax.ml_int_ty) +in ((g), (Some (((FStar_Extraction_ML_Syntax.MLP_Var (x)), ((when_clause)::[])))), (_174_234)))))) end | FStar_Syntax_Syntax.Pat_constant (s) -> begin ( @@ -776,12 +788,12 @@ let t = (FStar_TypeChecker_TcTerm.tc_constant FStar_Range.dummyRange s) in ( let mlty = (term_as_mlty g t) -in (let _174_236 = (let _174_234 = (let _174_233 = (let _174_232 = (FStar_Extraction_ML_Util.mlconst_of_const' p.FStar_Syntax_Syntax.p s) -in FStar_Extraction_ML_Syntax.MLP_Const (_174_232)) -in ((_174_233), ([]))) -in Some (_174_234)) -in (let _174_235 = (ok mlty) -in ((g), (_174_236), (_174_235)))))) +in (let _174_239 = (let _174_237 = (let _174_236 = (let _174_235 = (FStar_Extraction_ML_Util.mlconst_of_const' p.FStar_Syntax_Syntax.p s) +in FStar_Extraction_ML_Syntax.MLP_Const (_174_235)) +in ((_174_236), ([]))) +in Some (_174_237)) +in (let _174_238 = (ok mlty) +in ((g), (_174_239), (_174_238)))))) end | FStar_Syntax_Syntax.Pat_var (x) -> begin ( @@ -790,16 +802,16 @@ let mlty = (term_as_mlty g x.FStar_Syntax_Syntax.sort) in ( let g = (FStar_Extraction_ML_UEnv.extend_bv g x (([]), (mlty)) false false imp) -in (let _174_241 = if imp then begin +in (let _174_244 = if imp then begin None end else begin -(let _174_239 = (let _174_238 = (let _174_237 = (FStar_Extraction_ML_Syntax.bv_as_mlident x) -in FStar_Extraction_ML_Syntax.MLP_Var (_174_237)) -in ((_174_238), ([]))) -in Some (_174_239)) +(let _174_242 = (let _174_241 = (let _174_240 = (FStar_Extraction_ML_Syntax.bv_as_mlident x) +in FStar_Extraction_ML_Syntax.MLP_Var (_174_240)) +in ((_174_241), ([]))) +in Some (_174_242)) end -in (let _174_240 = (ok mlty) -in ((g), (_174_241), (_174_240)))))) +in (let _174_243 = (ok mlty) +in ((g), (_174_244), (_174_243)))))) end | FStar_Syntax_Syntax.Pat_wild (x) when disjunctive_pat -> begin ((g), (Some (((FStar_Extraction_ML_Syntax.MLP_Wild), ([])))), (true)) @@ -811,39 +823,39 @@ let mlty = (term_as_mlty g x.FStar_Syntax_Syntax.sort) in ( let g = (FStar_Extraction_ML_UEnv.extend_bv g x (([]), (mlty)) false false imp) -in (let _174_246 = if imp then begin +in (let _174_249 = if imp then begin None end else begin -(let _174_244 = (let _174_243 = (let _174_242 = (FStar_Extraction_ML_Syntax.bv_as_mlident x) -in FStar_Extraction_ML_Syntax.MLP_Var (_174_242)) -in ((_174_243), ([]))) -in Some (_174_244)) +(let _174_247 = (let _174_246 = (let _174_245 = (FStar_Extraction_ML_Syntax.bv_as_mlident x) +in FStar_Extraction_ML_Syntax.MLP_Var (_174_245)) +in ((_174_246), ([]))) +in Some (_174_247)) end -in (let _174_245 = (ok mlty) -in ((g), (_174_246), (_174_245)))))) +in (let _174_248 = (ok mlty) +in ((g), (_174_249), (_174_248)))))) end -| FStar_Syntax_Syntax.Pat_dot_term (_79_617) -> begin +| FStar_Syntax_Syntax.Pat_dot_term (_79_627) -> begin ((g), (None), (true)) end | FStar_Syntax_Syntax.Pat_cons (f, pats) -> begin ( -let _79_639 = (match ((FStar_Extraction_ML_UEnv.lookup_fv g f)) with -| FStar_Util.Inr ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (n); FStar_Extraction_ML_Syntax.mlty = _79_626; FStar_Extraction_ML_Syntax.loc = _79_624}, ttys, _79_632) -> begin +let _79_649 = (match ((FStar_Extraction_ML_UEnv.lookup_fv g f)) with +| FStar_Util.Inr ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (n); FStar_Extraction_ML_Syntax.mlty = _79_636; FStar_Extraction_ML_Syntax.loc = _79_634}, ttys, _79_642) -> begin ((n), (ttys)) end -| _79_636 -> begin +| _79_646 -> begin (FStar_All.failwith "Expected a constructor") end) -in (match (_79_639) with +in (match (_79_649) with | (d, tys) -> begin ( let nTyVars = (FStar_List.length (Prims.fst tys)) in ( -let _79_643 = (FStar_Util.first_N nTyVars pats) -in (match (_79_643) with +let _79_653 = (FStar_Util.first_N nTyVars pats) +in (match (_79_653) with | (tysVarPats, restPats) -> begin ( @@ -852,25 +864,25 @@ let f_ty_opt = try | () -> begin ( -let mlty_args = (FStar_All.pipe_right tysVarPats (FStar_List.map (fun _79_653 -> (match (_79_653) with -| (p, _79_652) -> begin +let mlty_args = (FStar_All.pipe_right tysVarPats (FStar_List.map (fun _79_663 -> (match (_79_663) with +| (p, _79_662) -> begin (match (p.FStar_Syntax_Syntax.v) with -| FStar_Syntax_Syntax.Pat_dot_term (_79_655, t) -> begin +| FStar_Syntax_Syntax.Pat_dot_term (_79_665, t) -> begin (term_as_mlty g t) end -| _79_660 -> begin +| _79_670 -> begin ( -let _79_663 = (FStar_Extraction_ML_UEnv.debug g (fun _79_661 -> (let _174_250 = (FStar_Syntax_Print.pat_to_string p) -in (FStar_Util.print1 "Pattern %s is not extractable" _174_250)))) +let _79_673 = (FStar_Extraction_ML_UEnv.debug g (fun _79_671 -> (let _174_253 = (FStar_Syntax_Print.pat_to_string p) +in (FStar_Util.print1 "Pattern %s is not extractable" _174_253)))) in (Prims.raise Un_extractable)) end) end)))) in ( let f_ty = (FStar_Extraction_ML_Util.subst tys mlty_args) -in (let _174_251 = (FStar_Extraction_ML_Util.uncurry_mlty_fun f_ty) -in Some (_174_251)))) +in (let _174_254 = (FStar_Extraction_ML_Util.uncurry_mlty_fun f_ty) +in Some (_174_254)))) end) with | Un_extractable -> begin @@ -878,55 +890,55 @@ None end in ( -let _79_679 = (FStar_Util.fold_map (fun g _79_671 -> (match (_79_671) with +let _79_689 = (FStar_Util.fold_map (fun g _79_681 -> (match (_79_681) with | (p, imp) -> begin ( -let _79_676 = (extract_one_pat disjunctive_pat true g p None) -in (match (_79_676) with -| (g, p, _79_675) -> begin +let _79_686 = (extract_one_pat disjunctive_pat true g p None) +in (match (_79_686) with +| (g, p, _79_685) -> begin ((g), (p)) end)) end)) g tysVarPats) -in (match (_79_679) with +in (match (_79_689) with | (g, tyMLPats) -> begin ( -let _79_706 = (FStar_Util.fold_map (fun _79_682 _79_685 -> (match (((_79_682), (_79_685))) with +let _79_716 = (FStar_Util.fold_map (fun _79_692 _79_695 -> (match (((_79_692), (_79_695))) with | ((g, f_ty_opt), (p, imp)) -> begin ( -let _79_696 = (match (f_ty_opt) with +let _79_706 = (match (f_ty_opt) with | Some ((hd)::rest, res) -> begin ((Some (((rest), (res)))), (Some (hd))) end -| _79_693 -> begin +| _79_703 -> begin ((None), (None)) end) -in (match (_79_696) with +in (match (_79_706) with | (f_ty_opt, expected_ty) -> begin ( -let _79_701 = (extract_one_pat disjunctive_pat false g p expected_ty) -in (match (_79_701) with -| (g, p, _79_700) -> begin +let _79_711 = (extract_one_pat disjunctive_pat false g p expected_ty) +in (match (_79_711) with +| (g, p, _79_710) -> begin ((((g), (f_ty_opt))), (p)) end)) end)) end)) ((g), (f_ty_opt)) restPats) -in (match (_79_706) with +in (match (_79_716) with | ((g, f_ty_opt), restMLPats) -> begin ( -let _79_714 = (let _174_258 = (FStar_All.pipe_right (FStar_List.append tyMLPats restMLPats) (FStar_List.collect (fun _79_2 -> (match (_79_2) with +let _79_724 = (let _174_261 = (FStar_All.pipe_right (FStar_List.append tyMLPats restMLPats) (FStar_List.collect (fun _79_3 -> (match (_79_3) with | Some (x) -> begin (x)::[] end -| _79_711 -> begin +| _79_721 -> begin [] end)))) -in (FStar_All.pipe_right _174_258 FStar_List.split)) -in (match (_79_714) with +in (FStar_All.pipe_right _174_261 FStar_List.split)) +in (match (_79_724) with | (mlPats, when_clauses) -> begin ( @@ -934,14 +946,14 @@ let pat_ty_compat = (match (f_ty_opt) with | Some ([], t) -> begin (ok t) end -| _79_720 -> begin +| _79_730 -> begin false end) -in (let _174_262 = (let _174_261 = (let _174_260 = (resugar_pat f.FStar_Syntax_Syntax.fv_qual (FStar_Extraction_ML_Syntax.MLP_CTor (((d), (mlPats))))) -in (let _174_259 = (FStar_All.pipe_right when_clauses FStar_List.flatten) -in ((_174_260), (_174_259)))) -in Some (_174_261)) -in ((g), (_174_262), (pat_ty_compat)))) +in (let _174_265 = (let _174_264 = (let _174_263 = (resugar_pat f.FStar_Syntax_Syntax.fv_qual (FStar_Extraction_ML_Syntax.MLP_CTor (((d), (mlPats))))) +in (let _174_262 = (FStar_All.pipe_right when_clauses FStar_List.flatten) +in ((_174_263), (_174_262)))) +in Some (_174_264)) +in ((g), (_174_265), (pat_ty_compat)))) end)) end)) end))) @@ -954,7 +966,7 @@ let extract_one_pat = (fun disj g p expected_t -> (match ((extract_one_pat disj | (g, Some (x, v), b) -> begin ((g), (((x), (v))), (b)) end -| _79_735 -> begin +| _79_745 -> begin (FStar_All.failwith "Impossible: Unable to translate pattern") end)) in ( @@ -964,8 +976,8 @@ let mk_when_clause = (fun whens -> (match (whens) with None end | (hd)::tl -> begin -(let _174_273 = (FStar_List.fold_left FStar_Extraction_ML_Util.conjoin hd tl) -in Some (_174_273)) +(let _174_276 = (FStar_List.fold_left FStar_Extraction_ML_Util.conjoin hd tl) +in Some (_174_276)) end)) in (match (p.FStar_Syntax_Syntax.v) with | FStar_Syntax_Syntax.Pat_disj ([]) -> begin @@ -974,40 +986,40 @@ end | FStar_Syntax_Syntax.Pat_disj ((p)::pats) -> begin ( -let _79_751 = (extract_one_pat true g p (Some (expected_t))) -in (match (_79_751) with +let _79_761 = (extract_one_pat true g p (Some (expected_t))) +in (match (_79_761) with | (g, p, b) -> begin ( -let _79_761 = (FStar_Util.fold_map (fun b p -> ( +let _79_771 = (FStar_Util.fold_map (fun b p -> ( -let _79_758 = (extract_one_pat true g p (Some (expected_t))) -in (match (_79_758) with -| (_79_755, p, b') -> begin +let _79_768 = (extract_one_pat true g p (Some (expected_t))) +in (match (_79_768) with +| (_79_765, p, b') -> begin (((b && b')), (p)) end))) b pats) -in (match (_79_761) with +in (match (_79_771) with | (b, ps) -> begin ( let ps = (p)::ps in ( -let _79_776 = (FStar_All.pipe_right ps (FStar_List.partition (fun _79_3 -> (match (_79_3) with -| (_79_765, (_79_769)::_79_767) -> begin +let _79_786 = (FStar_All.pipe_right ps (FStar_List.partition (fun _79_4 -> (match (_79_4) with +| (_79_775, (_79_779)::_79_777) -> begin true end -| _79_773 -> begin +| _79_783 -> begin false end)))) -in (match (_79_776) with +in (match (_79_786) with | (ps_when, rest) -> begin ( -let ps = (FStar_All.pipe_right ps_when (FStar_List.map (fun _79_779 -> (match (_79_779) with +let ps = (FStar_All.pipe_right ps_when (FStar_List.map (fun _79_789 -> (match (_79_789) with | (x, whens) -> begin -(let _174_278 = (mk_when_clause whens) -in ((x), (_174_278))) +(let _174_281 = (mk_when_clause whens) +in ((x), (_174_281))) end)))) in ( @@ -1016,22 +1028,22 @@ let res = (match (rest) with ((g), (ps), (b)) end | rest -> begin -(let _174_282 = (let _174_281 = (let _174_280 = (let _174_279 = (FStar_List.map Prims.fst rest) -in FStar_Extraction_ML_Syntax.MLP_Branch (_174_279)) -in ((_174_280), (None))) -in (_174_281)::ps) -in ((g), (_174_282), (b))) +(let _174_285 = (let _174_284 = (let _174_283 = (let _174_282 = (FStar_List.map Prims.fst rest) +in FStar_Extraction_ML_Syntax.MLP_Branch (_174_282)) +in ((_174_283), (None))) +in (_174_284)::ps) +in ((g), (_174_285), (b))) end) in res)) end))) end)) end)) end -| _79_785 -> begin +| _79_795 -> begin ( -let _79_791 = (extract_one_pat false g p (Some (expected_t))) -in (match (_79_791) with +let _79_801 = (extract_one_pat false g p (Some (expected_t))) +in (match (_79_801) with | (g, (p, whens), b) -> begin ( @@ -1044,74 +1056,74 @@ end))))) let maybe_eta_data_and_project_record : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.fv_qual Prims.option -> FStar_Extraction_ML_Syntax.mlty -> FStar_Extraction_ML_Syntax.mlexpr -> FStar_Extraction_ML_Syntax.mlexpr = (fun g qual residualType mlAppExpr -> ( let rec eta_args = (fun more_args t -> (match (t) with -| FStar_Extraction_ML_Syntax.MLTY_Fun (t0, _79_802, t1) -> begin +| FStar_Extraction_ML_Syntax.MLTY_Fun (t0, _79_812, t1) -> begin ( let x = (FStar_Extraction_ML_Syntax.gensym ()) -in (let _174_297 = (let _174_296 = (let _174_295 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t0) (FStar_Extraction_ML_Syntax.MLE_Var (x))) -in ((((x), (t0))), (_174_295))) -in (_174_296)::more_args) -in (eta_args _174_297 t1))) +in (let _174_300 = (let _174_299 = (let _174_298 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t0) (FStar_Extraction_ML_Syntax.MLE_Var (x))) +in ((((x), (t0))), (_174_298))) +in (_174_299)::more_args) +in (eta_args _174_300 t1))) end -| FStar_Extraction_ML_Syntax.MLTY_Named (_79_808, _79_810) -> begin +| FStar_Extraction_ML_Syntax.MLTY_Named (_79_818, _79_820) -> begin (((FStar_List.rev more_args)), (t)) end -| _79_814 -> begin +| _79_824 -> begin (FStar_All.failwith "Impossible: Head type is not an arrow") end)) in ( let as_record = (fun qual e -> (match (((e.FStar_Extraction_ML_Syntax.expr), (qual))) with -| (FStar_Extraction_ML_Syntax.MLE_CTor (_79_819, args), Some (FStar_Syntax_Syntax.Record_ctor (_79_824, fields))) -> begin +| (FStar_Extraction_ML_Syntax.MLE_CTor (_79_829, args), Some (FStar_Syntax_Syntax.Record_ctor (_79_834, fields))) -> begin ( -let path = (FStar_Extraction_ML_Util.record_field_path fields) +let path = (record_field_path fields) in ( let fields = (FStar_Extraction_ML_Util.record_fields fields args) in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty e.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Record (((path), (fields))))))) end -| _79_833 -> begin +| _79_843 -> begin e end)) in ( let resugar_and_maybe_eta = (fun qual e -> ( -let _79_839 = (eta_args [] residualType) -in (match (_79_839) with +let _79_849 = (eta_args [] residualType) +in (match (_79_849) with | (eargs, tres) -> begin (match (eargs) with | [] -> begin -(let _174_306 = (as_record qual e) -in (FStar_Extraction_ML_Util.resugar_exp _174_306)) +(let _174_309 = (as_record qual e) +in (FStar_Extraction_ML_Util.resugar_exp _174_309)) end -| _79_842 -> begin +| _79_852 -> begin ( -let _79_845 = (FStar_List.unzip eargs) -in (match (_79_845) with +let _79_855 = (FStar_List.unzip eargs) +in (match (_79_855) with | (binders, eargs) -> begin (match (e.FStar_Extraction_ML_Syntax.expr) with | FStar_Extraction_ML_Syntax.MLE_CTor (head, args) -> begin ( -let body = (let _174_308 = (let _174_307 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tres) (FStar_Extraction_ML_Syntax.MLE_CTor (((head), ((FStar_List.append args eargs)))))) -in (FStar_All.pipe_left (as_record qual) _174_307)) -in (FStar_All.pipe_left FStar_Extraction_ML_Util.resugar_exp _174_308)) +let body = (let _174_311 = (let _174_310 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tres) (FStar_Extraction_ML_Syntax.MLE_CTor (((head), ((FStar_List.append args eargs)))))) +in (FStar_All.pipe_left (as_record qual) _174_310)) +in (FStar_All.pipe_left FStar_Extraction_ML_Util.resugar_exp _174_311)) in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty e.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Fun (((binders), (body)))))) end -| _79_852 -> begin +| _79_862 -> begin (FStar_All.failwith "Impossible: Not a constructor") end) end)) end) end))) in (match (((mlAppExpr.FStar_Extraction_ML_Syntax.expr), (qual))) with -| (_79_854, None) -> begin +| (_79_864, None) -> begin mlAppExpr end -| (FStar_Extraction_ML_Syntax.MLE_App ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (mlp); FStar_Extraction_ML_Syntax.mlty = _79_860; FStar_Extraction_ML_Syntax.loc = _79_858}, (mle)::args), Some (FStar_Syntax_Syntax.Record_projector (f))) -> begin +| (FStar_Extraction_ML_Syntax.MLE_App ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (mlp); FStar_Extraction_ML_Syntax.mlty = _79_870; FStar_Extraction_ML_Syntax.loc = _79_868}, (mle)::args), Some (FStar_Syntax_Syntax.Record_projector (f))) -> begin ( let fn = (FStar_Extraction_ML_Util.mlpath_of_lid f) @@ -1124,22 +1136,22 @@ let e = (match (args) with | [] -> begin proj end -| _79_877 -> begin -(let _174_310 = (let _174_309 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) proj) -in ((_174_309), (args))) -in FStar_Extraction_ML_Syntax.MLE_App (_174_310)) +| _79_887 -> begin +(let _174_313 = (let _174_312 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) proj) +in ((_174_312), (args))) +in FStar_Extraction_ML_Syntax.MLE_App (_174_313)) end) in (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty e)))) end | ((FStar_Extraction_ML_Syntax.MLE_App ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (mlp); FStar_Extraction_ML_Syntax.mlty = _; FStar_Extraction_ML_Syntax.loc = _}, mlargs), Some (FStar_Syntax_Syntax.Data_ctor))) | ((FStar_Extraction_ML_Syntax.MLE_App ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name (mlp); FStar_Extraction_ML_Syntax.mlty = _; FStar_Extraction_ML_Syntax.loc = _}, mlargs), Some (FStar_Syntax_Syntax.Record_ctor (_)))) -> begin -(let _174_311 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (((mlp), (mlargs))))) -in (FStar_All.pipe_left (resugar_and_maybe_eta qual) _174_311)) +(let _174_314 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (((mlp), (mlargs))))) +in (FStar_All.pipe_left (resugar_and_maybe_eta qual) _174_314)) end | ((FStar_Extraction_ML_Syntax.MLE_Name (mlp), Some (FStar_Syntax_Syntax.Data_ctor))) | ((FStar_Extraction_ML_Syntax.MLE_Name (mlp), Some (FStar_Syntax_Syntax.Record_ctor (_)))) -> begin -(let _174_312 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (((mlp), ([]))))) -in (FStar_All.pipe_left (resugar_and_maybe_eta qual) _174_312)) +(let _174_315 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (((mlp), ([]))))) +in (FStar_All.pipe_left (resugar_and_maybe_eta qual) _174_315)) end -| _79_917 -> begin +| _79_927 -> begin mlAppExpr end))))) @@ -1153,64 +1165,64 @@ end) let rec term_as_mlexpr : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> (FStar_Extraction_ML_Syntax.mlexpr * FStar_Extraction_ML_Syntax.e_tag * FStar_Extraction_ML_Syntax.mlty) = (fun g t -> ( -let _79_926 = (term_as_mlexpr' g t) -in (match (_79_926) with +let _79_936 = (term_as_mlexpr' g t) +in (match (_79_936) with | (e, tag, ty) -> begin ( let tag = (maybe_downgrade_eff g tag ty) in ( -let _79_929 = (FStar_Extraction_ML_UEnv.debug g (fun u -> (let _174_337 = (let _174_336 = (FStar_Syntax_Print.tag_of_term t) -in (let _174_335 = (FStar_Syntax_Print.term_to_string t) -in (let _174_334 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule ty) -in (FStar_Util.format4 "term_as_mlexpr (%s) : %s has ML type %s and effect %s\n" _174_336 _174_335 _174_334 (FStar_Extraction_ML_Util.eff_to_string tag))))) -in (FStar_Util.print_string _174_337)))) +let _79_939 = (FStar_Extraction_ML_UEnv.debug g (fun u -> (let _174_340 = (let _174_339 = (FStar_Syntax_Print.tag_of_term t) +in (let _174_338 = (FStar_Syntax_Print.term_to_string t) +in (let _174_337 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule ty) +in (FStar_Util.format4 "term_as_mlexpr (%s) : %s has ML type %s and effect %s\n" _174_339 _174_338 _174_337 (FStar_Extraction_ML_Util.eff_to_string tag))))) +in (FStar_Util.print_string _174_340)))) in (erase g e ty tag))) end))) and check_term_as_mlexpr : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> FStar_Extraction_ML_Syntax.e_tag -> FStar_Extraction_ML_Syntax.mlty -> (FStar_Extraction_ML_Syntax.mlexpr * FStar_Extraction_ML_Syntax.mlty) = (fun g t f ty -> ( -let _79_937 = (check_term_as_mlexpr' g t f ty) -in (match (_79_937) with +let _79_947 = (check_term_as_mlexpr' g t f ty) +in (match (_79_947) with | (e, t) -> begin ( -let _79_942 = (erase g e t f) -in (match (_79_942) with -| (r, _79_940, t) -> begin +let _79_952 = (erase g e t f) +in (match (_79_952) with +| (r, _79_950, t) -> begin ((r), (t)) end)) end))) and check_term_as_mlexpr' : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> FStar_Extraction_ML_Syntax.e_tag -> FStar_Extraction_ML_Syntax.mlty -> (FStar_Extraction_ML_Syntax.mlexpr * FStar_Extraction_ML_Syntax.mlty) = (fun g e0 f ty -> ( -let _79_950 = (term_as_mlexpr g e0) -in (match (_79_950) with +let _79_960 = (term_as_mlexpr g e0) +in (match (_79_960) with | (e, tag, t) -> begin ( let tag = (maybe_downgrade_eff g tag t) in if (FStar_Extraction_ML_Util.eff_leq tag f) then begin -(let _174_346 = (maybe_coerce g e t ty) -in ((_174_346), (ty))) +(let _174_349 = (maybe_coerce g e t ty) +in ((_174_349), (ty))) end else begin (err_unexpected_eff e0 f tag) end) end))) and term_as_mlexpr' : FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> (FStar_Extraction_ML_Syntax.mlexpr * FStar_Extraction_ML_Syntax.e_tag * FStar_Extraction_ML_Syntax.mlty) = (fun g top -> ( -let _79_955 = (FStar_Extraction_ML_UEnv.debug g (fun u -> (let _174_353 = (let _174_352 = (FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos) -in (let _174_351 = (FStar_Syntax_Print.tag_of_term top) -in (let _174_350 = (FStar_Syntax_Print.term_to_string top) -in (FStar_Util.format3 "%s: term_as_mlexpr\' (%s) : %s \n" _174_352 _174_351 _174_350)))) -in (FStar_Util.print_string _174_353)))) +let _79_965 = (FStar_Extraction_ML_UEnv.debug g (fun u -> (let _174_356 = (let _174_355 = (FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos) +in (let _174_354 = (FStar_Syntax_Print.tag_of_term top) +in (let _174_353 = (FStar_Syntax_Print.term_to_string top) +in (FStar_Util.format3 "%s: term_as_mlexpr\' (%s) : %s \n" _174_355 _174_354 _174_353)))) +in (FStar_Util.print_string _174_356)))) in ( let t = (FStar_Syntax_Subst.compress top) in (match (t.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_unknown) | (FStar_Syntax_Syntax.Tm_delayed (_)) | (FStar_Syntax_Syntax.Tm_uvar (_)) | (FStar_Syntax_Syntax.Tm_bvar (_)) -> begin -(let _174_355 = (let _174_354 = (FStar_Syntax_Print.tag_of_term t) -in (FStar_Util.format1 "Impossible: Unexpected term: %s" _174_354)) -in (FStar_All.failwith _174_355)) +(let _174_358 = (let _174_357 = (FStar_Syntax_Print.tag_of_term t) +in (FStar_Util.format1 "Impossible: Unexpected term: %s" _174_357)) +in (FStar_All.failwith _174_358)) end | (FStar_Syntax_Syntax.Tm_type (_)) | (FStar_Syntax_Syntax.Tm_refine (_)) | (FStar_Syntax_Syntax.Tm_arrow (_)) -> begin ((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.ml_unit_ty)) @@ -1220,11 +1232,11 @@ end | ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Let ((FStar_Extraction_ML_Syntax.NonRec, flags, bodies), continuation); FStar_Extraction_ML_Syntax.mlty = mlty; FStar_Extraction_ML_Syntax.loc = loc}, tag, typ) -> begin (({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Let (((((FStar_Extraction_ML_Syntax.NonRec), ((FStar_Extraction_ML_Syntax.Mutable)::flags), (bodies))), (continuation))); FStar_Extraction_ML_Syntax.mlty = mlty; FStar_Extraction_ML_Syntax.loc = loc}), (tag), (typ)) end -| _79_996 -> begin +| _79_1006 -> begin (FStar_All.failwith "impossible") end) end -| FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_monadic (m, _79_1000)) -> begin +| FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_monadic (m, _79_1010)) -> begin ( let t = (FStar_Syntax_Subst.compress t) @@ -1233,8 +1245,8 @@ in (match (t.FStar_Syntax_Syntax.n) with ( let ed = (FStar_TypeChecker_Env.get_effect_decl g.FStar_Extraction_ML_UEnv.tcenv m) -in if (let _174_356 = (FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) -in (FStar_All.pipe_right _174_356 Prims.op_Negation)) then begin +in if (let _174_359 = (FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) +in (FStar_All.pipe_right _174_359 Prims.op_Negation)) then begin (term_as_mlexpr' g t) end else begin ( @@ -1242,48 +1254,48 @@ end else begin let ml_result_ty_1 = (term_as_mlty g lb.FStar_Syntax_Syntax.lbtyp) in ( -let _79_1020 = (term_as_mlexpr g lb.FStar_Syntax_Syntax.lbdef) -in (match (_79_1020) with -| (comp_1, _79_1017, _79_1019) -> begin +let _79_1030 = (term_as_mlexpr g lb.FStar_Syntax_Syntax.lbdef) +in (match (_79_1030) with +| (comp_1, _79_1027, _79_1029) -> begin ( -let _79_1039 = ( +let _79_1049 = ( -let k = (let _174_359 = (let _174_358 = (let _174_357 = (FStar_Util.left lb.FStar_Syntax_Syntax.lbname) -in (FStar_All.pipe_right _174_357 FStar_Syntax_Syntax.mk_binder)) -in (_174_358)::[]) -in (FStar_Syntax_Util.abs _174_359 body None)) +let k = (let _174_362 = (let _174_361 = (let _174_360 = (FStar_Util.left lb.FStar_Syntax_Syntax.lbname) +in (FStar_All.pipe_right _174_360 FStar_Syntax_Syntax.mk_binder)) +in (_174_361)::[]) +in (FStar_Syntax_Util.abs _174_362 body None)) in ( -let _79_1026 = (term_as_mlexpr g k) -in (match (_79_1026) with -| (ml_k, _79_1024, t_k) -> begin +let _79_1036 = (term_as_mlexpr g k) +in (match (_79_1036) with +| (ml_k, _79_1034, t_k) -> begin ( let m_2 = (match (t_k) with -| FStar_Extraction_ML_Syntax.MLTY_Fun (_79_1028, _79_1030, m_2) -> begin +| FStar_Extraction_ML_Syntax.MLTY_Fun (_79_1038, _79_1040, m_2) -> begin m_2 end -| _79_1035 -> begin +| _79_1045 -> begin (FStar_All.failwith "Impossible") end) in ((ml_k), (m_2))) end))) -in (match (_79_1039) with +in (match (_79_1049) with | (ml_k, ty) -> begin ( -let bind = (let _174_362 = (let _174_361 = (let _174_360 = (FStar_Extraction_ML_UEnv.monad_op_name ed "bind") -in (FStar_All.pipe_right _174_360 Prims.fst)) -in FStar_Extraction_ML_Syntax.MLE_Name (_174_361)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) _174_362)) -in (let _174_363 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty ty) (FStar_Extraction_ML_Syntax.MLE_App (((bind), ((comp_1)::(ml_k)::[]))))) -in ((_174_363), (FStar_Extraction_ML_Syntax.E_IMPURE), (ty)))) +let bind = (let _174_365 = (let _174_364 = (let _174_363 = (FStar_Extraction_ML_UEnv.monad_op_name ed "bind") +in (FStar_All.pipe_right _174_363 Prims.fst)) +in FStar_Extraction_ML_Syntax.MLE_Name (_174_364)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) _174_365)) +in (let _174_366 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty ty) (FStar_Extraction_ML_Syntax.MLE_App (((bind), ((comp_1)::(ml_k)::[]))))) +in ((_174_366), (FStar_Extraction_ML_Syntax.E_IMPURE), (ty)))) end)) end))) end) end -| _79_1042 -> begin +| _79_1052 -> begin (term_as_mlexpr' g t) end)) end @@ -1293,16 +1305,16 @@ end | FStar_Syntax_Syntax.Tm_constant (c) -> begin ( -let _79_1059 = (FStar_TypeChecker_TcTerm.type_of_tot_term g.FStar_Extraction_ML_UEnv.tcenv t) -in (match (_79_1059) with -| (_79_1055, ty, _79_1058) -> begin +let _79_1069 = (FStar_TypeChecker_TcTerm.type_of_tot_term g.FStar_Extraction_ML_UEnv.tcenv t) +in (match (_79_1069) with +| (_79_1065, ty, _79_1068) -> begin ( let ml_ty = (term_as_mlty g ty) -in (let _174_367 = (let _174_366 = (let _174_365 = (FStar_Extraction_ML_Util.mlconst_of_const' t.FStar_Syntax_Syntax.pos c) -in (FStar_All.pipe_left (fun _174_364 -> FStar_Extraction_ML_Syntax.MLE_Const (_174_364)) _174_365)) -in (FStar_Extraction_ML_Syntax.with_ty ml_ty _174_366)) -in ((_174_367), (FStar_Extraction_ML_Syntax.E_PURE), (ml_ty)))) +in (let _174_370 = (let _174_369 = (let _174_368 = (FStar_Extraction_ML_Util.mlconst_of_const' t.FStar_Syntax_Syntax.pos c) +in (FStar_All.pipe_left (fun _174_367 -> FStar_Extraction_ML_Syntax.MLE_Const (_174_367)) _174_368)) +in (FStar_Extraction_ML_Syntax.with_ty ml_ty _174_369)) +in ((_174_370), (FStar_Extraction_ML_Syntax.E_PURE), (ml_ty)))) end)) end | (FStar_Syntax_Syntax.Tm_name (_)) | (FStar_Syntax_Syntax.Tm_fvar (_)) -> begin @@ -1310,19 +1322,19 @@ if (is_type g t) then begin ((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.ml_unit_ty)) end else begin (match ((FStar_Extraction_ML_UEnv.lookup_term g t)) with -| (FStar_Util.Inl (_79_1068), _79_1071) -> begin +| (FStar_Util.Inl (_79_1078), _79_1081) -> begin ((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.ml_unit_ty)) end -| (FStar_Util.Inr (x, mltys, _79_1076), qual) -> begin +| (FStar_Util.Inr (x, mltys, _79_1086), qual) -> begin (match (mltys) with | ([], t) when (t = FStar_Extraction_ML_Syntax.ml_unit_ty) -> begin ((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE), (t)) end | ([], t) -> begin -(let _174_368 = (maybe_eta_data_and_project_record g qual t x) -in ((_174_368), (FStar_Extraction_ML_Syntax.E_PURE), (t))) +(let _174_371 = (maybe_eta_data_and_project_record g qual t x) +in ((_174_371), (FStar_Extraction_ML_Syntax.E_PURE), (t))) end -| _79_1088 -> begin +| _79_1098 -> begin (err_uninst g t mltys) end) end) @@ -1331,48 +1343,48 @@ end | FStar_Syntax_Syntax.Tm_abs (bs, body, copt) -> begin ( -let _79_1096 = (FStar_Syntax_Subst.open_term bs body) -in (match (_79_1096) with +let _79_1106 = (FStar_Syntax_Subst.open_term bs body) +in (match (_79_1106) with | (bs, body) -> begin ( -let _79_1099 = (binders_as_ml_binders g bs) -in (match (_79_1099) with +let _79_1109 = (binders_as_ml_binders g bs) +in (match (_79_1109) with | (ml_bs, env) -> begin ( -let _79_1103 = (term_as_mlexpr env body) -in (match (_79_1103) with +let _79_1113 = (term_as_mlexpr env body) +in (match (_79_1113) with | (ml_body, f, t) -> begin ( -let _79_1113 = (FStar_List.fold_right (fun _79_1107 _79_1110 -> (match (((_79_1107), (_79_1110))) with -| ((_79_1105, targ), (f, t)) -> begin +let _79_1123 = (FStar_List.fold_right (fun _79_1117 _79_1120 -> (match (((_79_1117), (_79_1120))) with +| ((_79_1115, targ), (f, t)) -> begin ((FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.MLTY_Fun (((targ), (f), (t))))) end)) ml_bs ((f), (t))) -in (match (_79_1113) with +in (match (_79_1123) with | (f, tfun) -> begin -(let _174_371 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tfun) (FStar_Extraction_ML_Syntax.MLE_Fun (((ml_bs), (ml_body))))) -in ((_174_371), (f), (tfun))) +(let _174_374 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tfun) (FStar_Extraction_ML_Syntax.MLE_Fun (((ml_bs), (ml_body))))) +in ((_174_374), (f), (tfun))) end)) end)) end)) end)) end -| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify); FStar_Syntax_Syntax.tk = _79_1119; FStar_Syntax_Syntax.pos = _79_1117; FStar_Syntax_Syntax.vars = _79_1115}, (t)::[]) -> begin +| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify); FStar_Syntax_Syntax.tk = _79_1129; FStar_Syntax_Syntax.pos = _79_1127; FStar_Syntax_Syntax.vars = _79_1125}, (t)::[]) -> begin ( -let _79_1130 = (term_as_mlexpr' g (Prims.fst t)) -in (match (_79_1130) with +let _79_1140 = (term_as_mlexpr' g (Prims.fst t)) +in (match (_79_1140) with | (ml, e_tag, mlty) -> begin ((ml), (FStar_Extraction_ML_Syntax.E_PURE), (mlty)) end)) end -| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reflect (_79_1138)); FStar_Syntax_Syntax.tk = _79_1136; FStar_Syntax_Syntax.pos = _79_1134; FStar_Syntax_Syntax.vars = _79_1132}, (t)::[]) -> begin +| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reflect (_79_1148)); FStar_Syntax_Syntax.tk = _79_1146; FStar_Syntax_Syntax.pos = _79_1144; FStar_Syntax_Syntax.vars = _79_1142}, (t)::[]) -> begin ( -let _79_1149 = (term_as_mlexpr' g (Prims.fst t)) -in (match (_79_1149) with +let _79_1159 = (term_as_mlexpr' g (Prims.fst t)) +in (match (_79_1159) with | (ml, e_tag, mlty) -> begin ((ml), (FStar_Extraction_ML_Syntax.E_IMPURE), (mlty)) end)) @@ -1380,51 +1392,51 @@ end | FStar_Syntax_Syntax.Tm_app (head, args) -> begin ( -let is_total = (fun _79_4 -> (match (_79_4) with +let is_total = (fun _79_5 -> (match (_79_5) with | FStar_Util.Inl (l) -> begin (FStar_Syntax_Util.is_total_lcomp l) end | FStar_Util.Inr (l) -> begin (FStar_Ident.lid_equals l FStar_Syntax_Const.effect_Tot_lid) end)) -in (match ((let _174_375 = (let _174_374 = (FStar_Syntax_Subst.compress head) -in _174_374.FStar_Syntax_Syntax.n) -in ((head.FStar_Syntax_Syntax.n), (_174_375)))) with -| (FStar_Syntax_Syntax.Tm_uvar (_79_1161), _79_1164) -> begin +in (match ((let _174_378 = (let _174_377 = (FStar_Syntax_Subst.compress head) +in _174_377.FStar_Syntax_Syntax.n) +in ((head.FStar_Syntax_Syntax.n), (_174_378)))) with +| (FStar_Syntax_Syntax.Tm_uvar (_79_1171), _79_1174) -> begin ( let t = (FStar_TypeChecker_Normalize.normalize ((FStar_TypeChecker_Normalize.Beta)::(FStar_TypeChecker_Normalize.Iota)::(FStar_TypeChecker_Normalize.Zeta)::(FStar_TypeChecker_Normalize.EraseUniverses)::(FStar_TypeChecker_Normalize.AllowUnboundUniverses)::[]) g.FStar_Extraction_ML_UEnv.tcenv t) in (term_as_mlexpr' g t)) end -| (_79_1168, FStar_Syntax_Syntax.Tm_abs (bs, _79_1171, Some (lc))) when (is_total lc) -> begin +| (_79_1178, FStar_Syntax_Syntax.Tm_abs (bs, _79_1181, Some (lc))) when (is_total lc) -> begin ( let t = (FStar_TypeChecker_Normalize.normalize ((FStar_TypeChecker_Normalize.Beta)::(FStar_TypeChecker_Normalize.Iota)::(FStar_TypeChecker_Normalize.Zeta)::(FStar_TypeChecker_Normalize.EraseUniverses)::(FStar_TypeChecker_Normalize.AllowUnboundUniverses)::[]) g.FStar_Extraction_ML_UEnv.tcenv t) in (term_as_mlexpr' g t)) end -| _79_1179 -> begin +| _79_1189 -> begin ( -let rec extract_app = (fun is_data _79_1184 _79_1187 restArgs -> (match (((_79_1184), (_79_1187))) with +let rec extract_app = (fun is_data _79_1194 _79_1197 restArgs -> (match (((_79_1194), (_79_1197))) with | ((mlhead, mlargs_f), (f, t)) -> begin (match (((restArgs), (t))) with -| ([], _79_1191) -> begin +| ([], _79_1201) -> begin ( let evaluation_order_guaranteed = ((((FStar_List.length mlargs_f) = (Prims.parse_int "1")) || (FStar_Extraction_ML_Util.codegen_fsharp ())) || (match (head.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = {FStar_Syntax_Syntax.v = v; FStar_Syntax_Syntax.ty = _79_1200; FStar_Syntax_Syntax.p = _79_1198}; FStar_Syntax_Syntax.fv_delta = _79_1196; FStar_Syntax_Syntax.fv_qual = _79_1194}) -> begin +| FStar_Syntax_Syntax.Tm_fvar ({FStar_Syntax_Syntax.fv_name = {FStar_Syntax_Syntax.v = v; FStar_Syntax_Syntax.ty = _79_1210; FStar_Syntax_Syntax.p = _79_1208}; FStar_Syntax_Syntax.fv_delta = _79_1206; FStar_Syntax_Syntax.fv_qual = _79_1204}) -> begin ((v = FStar_Syntax_Const.op_And) || (v = FStar_Syntax_Const.op_Or)) end -| _79_1206 -> begin +| _79_1216 -> begin false end)) in ( -let _79_1217 = if evaluation_order_guaranteed then begin -(let _174_384 = (FStar_All.pipe_right (FStar_List.rev mlargs_f) (FStar_List.map Prims.fst)) -in (([]), (_174_384))) +let _79_1227 = if evaluation_order_guaranteed then begin +(let _174_387 = (FStar_All.pipe_right (FStar_List.rev mlargs_f) (FStar_List.map Prims.fst)) +in (([]), (_174_387))) end else begin -(FStar_List.fold_left (fun _79_1210 _79_1213 -> (match (((_79_1210), (_79_1213))) with +(FStar_List.fold_left (fun _79_1220 _79_1223 -> (match (((_79_1220), (_79_1223))) with | ((lbs, out_args), (arg, f)) -> begin if ((f = FStar_Extraction_ML_Syntax.E_PURE) || (f = FStar_Extraction_ML_Syntax.E_GHOST)) then begin ((lbs), ((arg)::out_args)) @@ -1432,59 +1444,59 @@ end else begin ( let x = (FStar_Extraction_ML_Syntax.gensym ()) -in (let _174_388 = (let _174_387 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty arg.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Var (x))) -in (_174_387)::out_args) -in (((((x), (arg)))::lbs), (_174_388)))) +in (let _174_391 = (let _174_390 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty arg.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Var (x))) +in (_174_390)::out_args) +in (((((x), (arg)))::lbs), (_174_391)))) end end)) (([]), ([])) mlargs_f) end -in (match (_79_1217) with +in (match (_79_1227) with | (lbs, mlargs) -> begin ( -let app = (let _174_389 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t) (FStar_Extraction_ML_Syntax.MLE_App (((mlhead), (mlargs))))) -in (FStar_All.pipe_left (maybe_eta_data_and_project_record g is_data t) _174_389)) +let app = (let _174_392 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t) (FStar_Extraction_ML_Syntax.MLE_App (((mlhead), (mlargs))))) +in (FStar_All.pipe_left (maybe_eta_data_and_project_record g is_data t) _174_392)) in ( -let l_app = (FStar_List.fold_right (fun _79_1221 out -> (match (_79_1221) with +let l_app = (FStar_List.fold_right (fun _79_1231 out -> (match (_79_1231) with | (x, arg) -> begin (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty out.FStar_Extraction_ML_Syntax.mlty) (mk_MLE_Let false ((FStar_Extraction_ML_Syntax.NonRec), ([]), (({FStar_Extraction_ML_Syntax.mllb_name = x; FStar_Extraction_ML_Syntax.mllb_tysc = Some ((([]), (arg.FStar_Extraction_ML_Syntax.mlty))); FStar_Extraction_ML_Syntax.mllb_add_unit = false; FStar_Extraction_ML_Syntax.mllb_def = arg; FStar_Extraction_ML_Syntax.print_typ = true})::[])) out)) end)) lbs app) in ((l_app), (f), (t)))) end))) end -| (((arg, _79_1227))::rest, FStar_Extraction_ML_Syntax.MLTY_Fun (formal_t, f', t)) when (is_type g arg) -> begin +| (((arg, _79_1237))::rest, FStar_Extraction_ML_Syntax.MLTY_Fun (formal_t, f', t)) when (is_type g arg) -> begin if (type_leq g formal_t FStar_Extraction_ML_Syntax.ml_unit_ty) then begin -(let _174_393 = (let _174_392 = (FStar_Extraction_ML_Util.join arg.FStar_Syntax_Syntax.pos f f') -in ((_174_392), (t))) -in (extract_app is_data ((mlhead), ((((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE)))::mlargs_f)) _174_393 rest)) +(let _174_396 = (let _174_395 = (FStar_Extraction_ML_Util.join arg.FStar_Syntax_Syntax.pos f f') +in ((_174_395), (t))) +in (extract_app is_data ((mlhead), ((((FStar_Extraction_ML_Syntax.ml_unit), (FStar_Extraction_ML_Syntax.E_PURE)))::mlargs_f)) _174_396 rest)) end else begin -(let _174_398 = (let _174_397 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule mlhead) -in (let _174_396 = (FStar_Syntax_Print.term_to_string arg) -in (let _174_395 = (FStar_Syntax_Print.tag_of_term arg) -in (let _174_394 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule formal_t) -in (FStar_Util.format4 "Impossible: ill-typed application:\n\thead=%s, arg=%s, tag=%s\n\texpected type unit, got %s" _174_397 _174_396 _174_395 _174_394))))) -in (FStar_All.failwith _174_398)) +(let _174_401 = (let _174_400 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule mlhead) +in (let _174_399 = (FStar_Syntax_Print.term_to_string arg) +in (let _174_398 = (FStar_Syntax_Print.tag_of_term arg) +in (let _174_397 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule formal_t) +in (FStar_Util.format4 "Impossible: ill-typed application:\n\thead=%s, arg=%s, tag=%s\n\texpected type unit, got %s" _174_400 _174_399 _174_398 _174_397))))) +in (FStar_All.failwith _174_401)) end end -| (((e0, _79_1239))::rest, FStar_Extraction_ML_Syntax.MLTY_Fun (tExpected, f', t)) -> begin +| (((e0, _79_1249))::rest, FStar_Extraction_ML_Syntax.MLTY_Fun (tExpected, f', t)) -> begin ( let r = e0.FStar_Syntax_Syntax.pos in ( -let _79_1252 = (term_as_mlexpr g e0) -in (match (_79_1252) with +let _79_1262 = (term_as_mlexpr g e0) +in (match (_79_1262) with | (e0, f0, tInferred) -> begin ( let e0 = (maybe_coerce g e0 tInferred tExpected) -in (let _174_400 = (let _174_399 = (FStar_Extraction_ML_Util.join_l r ((f)::(f')::(f0)::[])) -in ((_174_399), (t))) -in (extract_app is_data ((mlhead), ((((e0), (f0)))::mlargs_f)) _174_400 rest))) +in (let _174_403 = (let _174_402 = (FStar_Extraction_ML_Util.join_l r ((f)::(f')::(f0)::[])) +in ((_174_402), (t))) +in (extract_app is_data ((mlhead), ((((e0), (f0)))::mlargs_f)) _174_403 rest))) end))) end -| _79_1255 -> begin +| _79_1265 -> begin (match ((FStar_Extraction_ML_Util.udelta_unfold g t)) with | Some (t) -> begin (extract_app is_data ((mlhead), (mlargs_f)) ((f), (t)) restArgs) @@ -1496,29 +1508,29 @@ end) end)) in ( -let extract_app_maybe_projector = (fun is_data mlhead _79_1264 args -> (match (_79_1264) with +let extract_app_maybe_projector = (fun is_data mlhead _79_1274 args -> (match (_79_1274) with | (f, t) -> begin (match (is_data) with -| Some (FStar_Syntax_Syntax.Record_projector (_79_1267)) -> begin +| Some (FStar_Syntax_Syntax.Record_projector (_79_1277)) -> begin ( let rec remove_implicits = (fun args f t -> (match (((args), (t))) with -| (((a0, Some (FStar_Syntax_Syntax.Implicit (_79_1277))))::args, FStar_Extraction_ML_Syntax.MLTY_Fun (_79_1283, f', t)) -> begin -(let _174_415 = (FStar_Extraction_ML_Util.join a0.FStar_Syntax_Syntax.pos f f') -in (remove_implicits args _174_415 t)) +| (((a0, Some (FStar_Syntax_Syntax.Implicit (_79_1287))))::args, FStar_Extraction_ML_Syntax.MLTY_Fun (_79_1293, f', t)) -> begin +(let _174_418 = (FStar_Extraction_ML_Util.join a0.FStar_Syntax_Syntax.pos f f') +in (remove_implicits args _174_418 t)) end -| _79_1290 -> begin +| _79_1300 -> begin ((args), (f), (t)) end)) in ( -let _79_1294 = (remove_implicits args f t) -in (match (_79_1294) with +let _79_1304 = (remove_implicits args f t) +in (match (_79_1304) with | (args, f, t) -> begin (extract_app is_data ((mlhead), ([])) ((f), (t)) args) end))) end -| _79_1296 -> begin +| _79_1306 -> begin (extract_app is_data ((mlhead), ([])) ((f), (t)) args) end) end)) @@ -1532,44 +1544,44 @@ in (match (head.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_bvar (_)) | (FStar_Syntax_Syntax.Tm_fvar (_)) -> begin ( -let _79_1317 = (match ((FStar_Extraction_ML_UEnv.lookup_term g head)) with +let _79_1327 = (match ((FStar_Extraction_ML_UEnv.lookup_term g head)) with | (FStar_Util.Inr (u), q) -> begin ((u), (q)) end -| _79_1309 -> begin +| _79_1319 -> begin (FStar_All.failwith "FIXME Ty") end) -in (match (_79_1317) with +in (match (_79_1327) with | ((head_ml, (vars, t), inst_ok), qual) -> begin ( let has_typ_apps = (match (args) with -| ((a, _79_1322))::_79_1319 -> begin +| ((a, _79_1332))::_79_1329 -> begin (is_type g a) end -| _79_1326 -> begin +| _79_1336 -> begin false end) in ( -let _79_1372 = (match (vars) with -| (_79_1331)::_79_1329 when ((not (has_typ_apps)) && inst_ok) -> begin +let _79_1382 = (match (vars) with +| (_79_1341)::_79_1339 when ((not (has_typ_apps)) && inst_ok) -> begin ((head_ml), (t), (args)) end -| _79_1334 -> begin +| _79_1344 -> begin ( let n = (FStar_List.length vars) in if (n <= (FStar_List.length args)) then begin ( -let _79_1338 = (FStar_Util.first_N n args) -in (match (_79_1338) with +let _79_1348 = (FStar_Util.first_N n args) +in (match (_79_1348) with | (prefix, rest) -> begin ( -let prefixAsMLTypes = (FStar_List.map (fun _79_1342 -> (match (_79_1342) with -| (x, _79_1341) -> begin +let prefixAsMLTypes = (FStar_List.map (fun _79_1352 -> (match (_79_1352) with +| (x, _79_1351) -> begin (term_as_mlty g x) end)) prefix) in ( @@ -1581,16 +1593,16 @@ let head = (match (head_ml.FStar_Extraction_ML_Syntax.expr) with | (FStar_Extraction_ML_Syntax.MLE_Name (_)) | (FStar_Extraction_ML_Syntax.MLE_Var (_)) -> begin ( -let _79_1351 = head_ml -in {FStar_Extraction_ML_Syntax.expr = _79_1351.FStar_Extraction_ML_Syntax.expr; FStar_Extraction_ML_Syntax.mlty = t; FStar_Extraction_ML_Syntax.loc = _79_1351.FStar_Extraction_ML_Syntax.loc}) +let _79_1361 = head_ml +in {FStar_Extraction_ML_Syntax.expr = _79_1361.FStar_Extraction_ML_Syntax.expr; FStar_Extraction_ML_Syntax.mlty = t; FStar_Extraction_ML_Syntax.loc = _79_1361.FStar_Extraction_ML_Syntax.loc}) end -| FStar_Extraction_ML_Syntax.MLE_App (head, ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Unit); FStar_Extraction_ML_Syntax.mlty = _79_1357; FStar_Extraction_ML_Syntax.loc = _79_1355})::[]) -> begin +| FStar_Extraction_ML_Syntax.MLE_App (head, ({FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Unit); FStar_Extraction_ML_Syntax.mlty = _79_1367; FStar_Extraction_ML_Syntax.loc = _79_1365})::[]) -> begin (FStar_All.pipe_right (FStar_Extraction_ML_Syntax.MLE_App (((( -let _79_1364 = head -in {FStar_Extraction_ML_Syntax.expr = _79_1364.FStar_Extraction_ML_Syntax.expr; FStar_Extraction_ML_Syntax.mlty = FStar_Extraction_ML_Syntax.MLTY_Fun (((FStar_Extraction_ML_Syntax.ml_unit_ty), (FStar_Extraction_ML_Syntax.E_PURE), (t))); FStar_Extraction_ML_Syntax.loc = _79_1364.FStar_Extraction_ML_Syntax.loc})), ((FStar_Extraction_ML_Syntax.ml_unit)::[])))) (FStar_Extraction_ML_Syntax.with_ty t)) +let _79_1374 = head +in {FStar_Extraction_ML_Syntax.expr = _79_1374.FStar_Extraction_ML_Syntax.expr; FStar_Extraction_ML_Syntax.mlty = FStar_Extraction_ML_Syntax.MLTY_Fun (((FStar_Extraction_ML_Syntax.ml_unit_ty), (FStar_Extraction_ML_Syntax.E_PURE), (t))); FStar_Extraction_ML_Syntax.loc = _79_1374.FStar_Extraction_ML_Syntax.loc})), ((FStar_Extraction_ML_Syntax.ml_unit)::[])))) (FStar_Extraction_ML_Syntax.with_ty t)) end -| _79_1367 -> begin +| _79_1377 -> begin (FStar_All.failwith "Impossible: Unexpected head term") end) in ((head), (t), (rest))))) @@ -1599,24 +1611,24 @@ end else begin (err_uninst g head ((vars), (t))) end) end) -in (match (_79_1372) with +in (match (_79_1382) with | (head_ml, head_t, args) -> begin (match (args) with | [] -> begin -(let _174_417 = (maybe_eta_data_and_project_record g qual head_t head_ml) -in ((_174_417), (FStar_Extraction_ML_Syntax.E_PURE), (head_t))) +(let _174_420 = (maybe_eta_data_and_project_record g qual head_t head_ml) +in ((_174_420), (FStar_Extraction_ML_Syntax.E_PURE), (head_t))) end -| _79_1375 -> begin +| _79_1385 -> begin (extract_app_maybe_projector qual head_ml ((FStar_Extraction_ML_Syntax.E_PURE), (head_t)) args) end) end))) end)) end -| _79_1377 -> begin +| _79_1387 -> begin ( -let _79_1381 = (term_as_mlexpr g head) -in (match (_79_1381) with +let _79_1391 = (term_as_mlexpr g head) +in (match (_79_1391) with | (head, f, t) -> begin (extract_app_maybe_projector None head ((f), (t)) args) end)) @@ -1645,8 +1657,8 @@ end end) in ( -let _79_1398 = (check_term_as_mlexpr g e0 f t) -in (match (_79_1398) with +let _79_1408 = (check_term_as_mlexpr g e0 f t) +in (match (_79_1408) with | (e, t) -> begin ((e), (f), (t)) end)))) @@ -1657,7 +1669,7 @@ end let top_level = (FStar_Syntax_Syntax.is_top_level lbs) in ( -let _79_1414 = if is_rec then begin +let _79_1424 = if is_rec then begin (FStar_Syntax_Subst.open_let_rec lbs e') end else begin if (FStar_Syntax_Syntax.is_top_level lbs) then begin @@ -1668,43 +1680,43 @@ end else begin let lb = (FStar_List.hd lbs) in ( -let x = (let _174_418 = (FStar_Util.left lb.FStar_Syntax_Syntax.lbname) -in (FStar_Syntax_Syntax.freshen_bv _174_418)) +let x = (let _174_421 = (FStar_Util.left lb.FStar_Syntax_Syntax.lbname) +in (FStar_Syntax_Syntax.freshen_bv _174_421)) in ( let lb = ( -let _79_1408 = lb -in {FStar_Syntax_Syntax.lbname = FStar_Util.Inl (x); FStar_Syntax_Syntax.lbunivs = _79_1408.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _79_1408.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _79_1408.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = _79_1408.FStar_Syntax_Syntax.lbdef}) +let _79_1418 = lb +in {FStar_Syntax_Syntax.lbname = FStar_Util.Inl (x); FStar_Syntax_Syntax.lbunivs = _79_1418.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _79_1418.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _79_1418.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = _79_1418.FStar_Syntax_Syntax.lbdef}) in ( let e' = (FStar_Syntax_Subst.subst ((FStar_Syntax_Syntax.DB ((((Prims.parse_int "0")), (x))))::[]) e') in (((lb)::[]), (e')))))) end end -in (match (_79_1414) with +in (match (_79_1424) with | (lbs, e') -> begin ( let lbs = if top_level then begin (FStar_All.pipe_right lbs (FStar_List.map (fun lb -> ( -let tcenv = (let _174_420 = (FStar_Ident.lid_of_path (FStar_List.append (Prims.fst g.FStar_Extraction_ML_UEnv.currentModule) (((Prims.snd g.FStar_Extraction_ML_UEnv.currentModule))::[])) FStar_Range.dummyRange) -in (FStar_TypeChecker_Env.set_current_module g.FStar_Extraction_ML_UEnv.tcenv _174_420)) +let tcenv = (let _174_423 = (FStar_Ident.lid_of_path (FStar_List.append (Prims.fst g.FStar_Extraction_ML_UEnv.currentModule) (((Prims.snd g.FStar_Extraction_ML_UEnv.currentModule))::[])) FStar_Range.dummyRange) +in (FStar_TypeChecker_Env.set_current_module g.FStar_Extraction_ML_UEnv.tcenv _174_423)) in ( let lbdef = (FStar_TypeChecker_Normalize.normalize ((FStar_TypeChecker_Normalize.AllowUnboundUniverses)::(FStar_TypeChecker_Normalize.EraseUniverses)::(FStar_TypeChecker_Normalize.Inlining)::(FStar_TypeChecker_Normalize.Eager_unfolding)::(FStar_TypeChecker_Normalize.Exclude (FStar_TypeChecker_Normalize.Zeta))::(FStar_TypeChecker_Normalize.PureSubtermsWithinComputations)::(FStar_TypeChecker_Normalize.Primops)::[]) tcenv lb.FStar_Syntax_Syntax.lbdef) in ( -let _79_1418 = lb -in {FStar_Syntax_Syntax.lbname = _79_1418.FStar_Syntax_Syntax.lbname; FStar_Syntax_Syntax.lbunivs = _79_1418.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _79_1418.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _79_1418.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = lbdef})))))) +let _79_1428 = lb +in {FStar_Syntax_Syntax.lbname = _79_1428.FStar_Syntax_Syntax.lbname; FStar_Syntax_Syntax.lbunivs = _79_1428.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _79_1428.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _79_1428.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = lbdef})))))) end else begin lbs end in ( -let maybe_generalize = (fun _79_1428 -> (match (_79_1428) with -| {FStar_Syntax_Syntax.lbname = lbname_; FStar_Syntax_Syntax.lbunivs = _79_1426; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = lbeff; FStar_Syntax_Syntax.lbdef = e} -> begin +let maybe_generalize = (fun _79_1438 -> (match (_79_1438) with +| {FStar_Syntax_Syntax.lbname = lbname_; FStar_Syntax_Syntax.lbunivs = _79_1436; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = lbeff; FStar_Syntax_Syntax.lbdef = e} -> begin ( let f_e = (effect_as_etag g lbeff) @@ -1712,24 +1724,24 @@ in ( let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_arrow (bs, c) when (let _174_423 = (FStar_List.hd bs) -in (FStar_All.pipe_right _174_423 (is_type_binder g))) -> begin +| FStar_Syntax_Syntax.Tm_arrow (bs, c) when (let _174_426 = (FStar_List.hd bs) +in (FStar_All.pipe_right _174_426 (is_type_binder g))) -> begin ( -let _79_1437 = (FStar_Syntax_Subst.open_comp bs c) -in (match (_79_1437) with +let _79_1447 = (FStar_Syntax_Subst.open_comp bs c) +in (match (_79_1447) with | (bs, c) -> begin ( -let _79_1447 = (match ((FStar_Util.prefix_until (fun x -> (not ((is_type_binder g x)))) bs)) with +let _79_1457 = (match ((FStar_Util.prefix_until (fun x -> (not ((is_type_binder g x)))) bs)) with | None -> begin ((bs), ((FStar_Syntax_Util.comp_result c))) end | Some (bs, b, rest) -> begin -(let _174_425 = (FStar_Syntax_Util.arrow ((b)::rest) c) -in ((bs), (_174_425))) +(let _174_428 = (FStar_Syntax_Util.arrow ((b)::rest) c) +in ((bs), (_174_428))) end) -in (match (_79_1447) with +in (match (_79_1457) with | (tbinders, tbody) -> begin ( @@ -1738,33 +1750,33 @@ in ( let e = (normalize_abs e) in (match (e.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_abs (bs, body, _79_1453) -> begin +| FStar_Syntax_Syntax.Tm_abs (bs, body, _79_1463) -> begin ( -let _79_1458 = (FStar_Syntax_Subst.open_term bs body) -in (match (_79_1458) with +let _79_1468 = (FStar_Syntax_Subst.open_term bs body) +in (match (_79_1468) with | (bs, body) -> begin if (n_tbinders <= (FStar_List.length bs)) then begin ( -let _79_1461 = (FStar_Util.first_N n_tbinders bs) -in (match (_79_1461) with +let _79_1471 = (FStar_Util.first_N n_tbinders bs) +in (match (_79_1471) with | (targs, rest_args) -> begin ( let expected_source_ty = ( -let s = (FStar_List.map2 (fun _79_1465 _79_1469 -> (match (((_79_1465), (_79_1469))) with -| ((x, _79_1464), (y, _79_1468)) -> begin -(let _174_429 = (let _174_428 = (FStar_Syntax_Syntax.bv_to_name y) -in ((x), (_174_428))) -in FStar_Syntax_Syntax.NT (_174_429)) +let s = (FStar_List.map2 (fun _79_1475 _79_1479 -> (match (((_79_1475), (_79_1479))) with +| ((x, _79_1474), (y, _79_1478)) -> begin +(let _174_432 = (let _174_431 = (FStar_Syntax_Syntax.bv_to_name y) +in ((x), (_174_431))) +in FStar_Syntax_Syntax.NT (_174_432)) end)) tbinders targs) in (FStar_Syntax_Subst.subst s tbody)) in ( -let env = (FStar_List.fold_left (fun env _79_1476 -> (match (_79_1476) with -| (a, _79_1475) -> begin +let env = (FStar_List.fold_left (fun env _79_1486 -> (match (_79_1486) with +| (a, _79_1485) -> begin (FStar_Extraction_ML_UEnv.extend_ty env a None) end)) g targs) in ( @@ -1772,18 +1784,18 @@ in ( let expected_t = (term_as_mlty env expected_source_ty) in ( -let polytype = (let _174_433 = (FStar_All.pipe_right targs (FStar_List.map (fun _79_1482 -> (match (_79_1482) with -| (x, _79_1481) -> begin +let polytype = (let _174_436 = (FStar_All.pipe_right targs (FStar_List.map (fun _79_1492 -> (match (_79_1492) with +| (x, _79_1491) -> begin (FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x) end)))) -in ((_174_433), (expected_t))) +in ((_174_436), (expected_t))) in ( let add_unit = (match (rest_args) with | [] -> begin (not ((is_fstar_value body))) end -| _79_1486 -> begin +| _79_1496 -> begin false end) in ( @@ -1799,7 +1811,7 @@ let body = (match (rest_args) with | [] -> begin body end -| _79_1491 -> begin +| _79_1501 -> begin (FStar_Syntax_Util.abs rest_args body None) end) in ((lbname_), (f_e), (((t), (((targs), (polytype))))), (add_unit), (body))))))))) @@ -1812,8 +1824,8 @@ end | (FStar_Syntax_Syntax.Tm_uinst (_)) | (FStar_Syntax_Syntax.Tm_fvar (_)) | (FStar_Syntax_Syntax.Tm_name (_)) -> begin ( -let env = (FStar_List.fold_left (fun env _79_1506 -> (match (_79_1506) with -| (a, _79_1505) -> begin +let env = (FStar_List.fold_left (fun env _79_1516 -> (match (_79_1516) with +| (a, _79_1515) -> begin (FStar_Extraction_ML_UEnv.extend_ty env a None) end)) g tbinders) in ( @@ -1821,30 +1833,30 @@ in ( let expected_t = (term_as_mlty env tbody) in ( -let polytype = (let _174_437 = (FStar_All.pipe_right tbinders (FStar_List.map (fun _79_1512 -> (match (_79_1512) with -| (x, _79_1511) -> begin +let polytype = (let _174_440 = (FStar_All.pipe_right tbinders (FStar_List.map (fun _79_1522 -> (match (_79_1522) with +| (x, _79_1521) -> begin (FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x) end)))) -in ((_174_437), (expected_t))) +in ((_174_440), (expected_t))) in ( -let args = (FStar_All.pipe_right tbinders (FStar_List.map (fun _79_1517 -> (match (_79_1517) with -| (bv, _79_1516) -> begin -(let _174_439 = (FStar_Syntax_Syntax.bv_to_name bv) -in (FStar_All.pipe_right _174_439 FStar_Syntax_Syntax.as_arg)) +let args = (FStar_All.pipe_right tbinders (FStar_List.map (fun _79_1527 -> (match (_79_1527) with +| (bv, _79_1526) -> begin +(let _174_442 = (FStar_Syntax_Syntax.bv_to_name bv) +in (FStar_All.pipe_right _174_442 FStar_Syntax_Syntax.as_arg)) end)))) in ( let e = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (((e), (args)))) None e.FStar_Syntax_Syntax.pos) in ((lbname_), (f_e), (((t), (((tbinders), (polytype))))), (false), (e))))))) end -| _79_1521 -> begin +| _79_1531 -> begin (err_value_restriction e) end))) end)) end)) end -| _79_1523 -> begin +| _79_1533 -> begin ( let expected_t = (term_as_mlty g t) @@ -1853,12 +1865,12 @@ end))) end)) in ( -let check_lb = (fun env _79_1538 -> (match (_79_1538) with +let check_lb = (fun env _79_1548 -> (match (_79_1548) with | (nm, (lbname, f, (t, (targs, polytype)), add_unit, e)) -> begin ( -let env = (FStar_List.fold_left (fun env _79_1543 -> (match (_79_1543) with -| (a, _79_1542) -> begin +let env = (FStar_List.fold_left (fun env _79_1553 -> (match (_79_1553) with +| (a, _79_1552) -> begin (FStar_Extraction_ML_UEnv.extend_ty env a None) end)) env targs) in ( @@ -1870,9 +1882,9 @@ end else begin end in ( -let _79_1549 = (check_term_as_mlexpr env e f expected_t) -in (match (_79_1549) with -| (e, _79_1548) -> begin +let _79_1559 = (check_term_as_mlexpr env e f expected_t) +in (match (_79_1559) with +| (e, _79_1558) -> begin ( let f = (maybe_downgrade_eff env f expected_t) @@ -1884,23 +1896,23 @@ in ( let lbs = (FStar_All.pipe_right lbs (FStar_List.map maybe_generalize)) in ( -let _79_1574 = (FStar_List.fold_right (fun lb _79_1555 -> (match (_79_1555) with +let _79_1584 = (FStar_List.fold_right (fun lb _79_1565 -> (match (_79_1565) with | (env, lbs) -> begin ( -let _79_1568 = lb -in (match (_79_1568) with -| (lbname, _79_1558, (t, (_79_1561, polytype)), add_unit, _79_1567) -> begin +let _79_1578 = lb +in (match (_79_1578) with +| (lbname, _79_1568, (t, (_79_1571, polytype)), add_unit, _79_1577) -> begin ( -let _79_1571 = (FStar_Extraction_ML_UEnv.extend_lb env lbname t polytype add_unit true) -in (match (_79_1571) with +let _79_1581 = (FStar_Extraction_ML_UEnv.extend_lb env lbname t polytype add_unit true) +in (match (_79_1581) with | (env, nm) -> begin ((env), ((((nm), (lb)))::lbs)) end)) end)) end)) lbs ((g), ([]))) -in (match (_79_1574) with +in (match (_79_1584) with | (env_body, lbs) -> begin ( @@ -1917,14 +1929,14 @@ in ( let e'_rng = e'.FStar_Syntax_Syntax.pos in ( -let _79_1581 = (term_as_mlexpr env_body e') -in (match (_79_1581) with +let _79_1591 = (term_as_mlexpr env_body e') +in (match (_79_1591) with | (e', f', t') -> begin ( -let f = (let _174_449 = (let _174_448 = (FStar_List.map Prims.fst lbs) -in (f')::_174_448) -in (FStar_Extraction_ML_Util.join_l e'_rng _174_449)) +let f = (let _174_452 = (let _174_451 = (FStar_List.map Prims.fst lbs) +in (f')::_174_451) +in (FStar_Extraction_ML_Util.join_l e'_rng _174_452)) in ( let is_rec = if (is_rec = true) then begin @@ -1932,12 +1944,12 @@ FStar_Extraction_ML_Syntax.Rec end else begin FStar_Extraction_ML_Syntax.NonRec end -in (let _174_454 = (let _174_453 = (let _174_451 = (let _174_450 = (FStar_List.map Prims.snd lbs) -in ((is_rec), ([]), (_174_450))) -in (mk_MLE_Let top_level _174_451 e')) -in (let _174_452 = (FStar_Extraction_ML_Util.mlloc_of_range t.FStar_Syntax_Syntax.pos) -in (FStar_Extraction_ML_Syntax.with_ty_loc t' _174_453 _174_452))) -in ((_174_454), (f), (t'))))) +in (let _174_457 = (let _174_456 = (let _174_454 = (let _174_453 = (FStar_List.map Prims.snd lbs) +in ((is_rec), ([]), (_174_453))) +in (mk_MLE_Let top_level _174_454 e')) +in (let _174_455 = (FStar_Extraction_ML_Util.mlloc_of_range t.FStar_Syntax_Syntax.pos) +in (FStar_Extraction_ML_Syntax.with_ty_loc t' _174_456 _174_455))) +in ((_174_457), (f), (t'))))) end))))) end)))))) end))) @@ -1945,13 +1957,13 @@ end | FStar_Syntax_Syntax.Tm_match (scrutinee, pats) -> begin ( -let _79_1591 = (term_as_mlexpr g scrutinee) -in (match (_79_1591) with +let _79_1601 = (term_as_mlexpr g scrutinee) +in (match (_79_1601) with | (e, f_e, t_e) -> begin ( -let _79_1595 = (check_pats_for_ite pats) -in (match (_79_1595) with +let _79_1605 = (check_pats_for_ite pats) +in (match (_79_1605) with | (b, then_e, else_e) -> begin ( @@ -1961,17 +1973,17 @@ in if b then begin | (Some (then_e), Some (else_e)) -> begin ( -let _79_1607 = (term_as_mlexpr g then_e) -in (match (_79_1607) with +let _79_1617 = (term_as_mlexpr g then_e) +in (match (_79_1617) with | (then_mle, f_then, t_then) -> begin ( -let _79_1611 = (term_as_mlexpr g else_e) -in (match (_79_1611) with +let _79_1621 = (term_as_mlexpr g else_e) +in (match (_79_1621) with | (else_mle, f_else, t_else) -> begin ( -let _79_1614 = if (type_leq g t_then t_else) then begin +let _79_1624 = if (type_leq g t_then t_else) then begin ((t_else), (no_lift)) end else begin if (type_leq g t_else t_then) then begin @@ -1980,47 +1992,47 @@ end else begin ((FStar_Extraction_ML_Syntax.MLTY_Top), (FStar_Extraction_ML_Syntax.apply_obj_repr)) end end -in (match (_79_1614) with +in (match (_79_1624) with | (t_branch, maybe_lift) -> begin -(let _174_485 = (let _174_483 = (let _174_482 = (let _174_481 = (maybe_lift then_mle t_then) -in (let _174_480 = (let _174_479 = (maybe_lift else_mle t_else) -in Some (_174_479)) -in ((e), (_174_481), (_174_480)))) -in FStar_Extraction_ML_Syntax.MLE_If (_174_482)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_branch) _174_483)) -in (let _174_484 = (FStar_Extraction_ML_Util.join then_e.FStar_Syntax_Syntax.pos f_then f_else) -in ((_174_485), (_174_484), (t_branch)))) +(let _174_488 = (let _174_486 = (let _174_485 = (let _174_484 = (maybe_lift then_mle t_then) +in (let _174_483 = (let _174_482 = (maybe_lift else_mle t_else) +in Some (_174_482)) +in ((e), (_174_484), (_174_483)))) +in FStar_Extraction_ML_Syntax.MLE_If (_174_485)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_branch) _174_486)) +in (let _174_487 = (FStar_Extraction_ML_Util.join then_e.FStar_Syntax_Syntax.pos f_then f_else) +in ((_174_488), (_174_487), (t_branch)))) end)) end)) end)) end -| _79_1616 -> begin +| _79_1626 -> begin (FStar_All.failwith "ITE pats matched but then and else expressions not found?") end) end else begin ( -let _79_1648 = (FStar_All.pipe_right pats (FStar_Util.fold_map (fun compat br -> ( +let _79_1658 = (FStar_All.pipe_right pats (FStar_Util.fold_map (fun compat br -> ( -let _79_1622 = (FStar_Syntax_Subst.open_branch br) -in (match (_79_1622) with +let _79_1632 = (FStar_Syntax_Subst.open_branch br) +in (match (_79_1632) with | (pat, when_opt, branch) -> begin ( -let _79_1626 = (extract_pat g pat t_e) -in (match (_79_1626) with +let _79_1636 = (extract_pat g pat t_e) +in (match (_79_1636) with | (env, p, pat_t_compat) -> begin ( -let _79_1637 = (match (when_opt) with +let _79_1647 = (match (when_opt) with | None -> begin ((None), (FStar_Extraction_ML_Syntax.E_PURE)) end | Some (w) -> begin ( -let _79_1633 = (term_as_mlexpr env w) -in (match (_79_1633) with +let _79_1643 = (term_as_mlexpr env w) +in (match (_79_1643) with | (w, f_w, t_w) -> begin ( @@ -2028,26 +2040,26 @@ let w = (maybe_coerce env w t_w FStar_Extraction_ML_Syntax.ml_bool_ty) in ((Some (w)), (f_w))) end)) end) -in (match (_79_1637) with +in (match (_79_1647) with | (when_opt, f_when) -> begin ( -let _79_1641 = (term_as_mlexpr env branch) -in (match (_79_1641) with +let _79_1651 = (term_as_mlexpr env branch) +in (match (_79_1651) with | (mlbranch, f_branch, t_branch) -> begin -(let _174_489 = (FStar_All.pipe_right p (FStar_List.map (fun _79_1644 -> (match (_79_1644) with +(let _174_492 = (FStar_All.pipe_right p (FStar_List.map (fun _79_1654 -> (match (_79_1654) with | (p, wopt) -> begin ( let when_clause = (FStar_Extraction_ML_Util.conjoin_opt wopt when_opt) in ((p), (((when_clause), (f_when))), (((mlbranch), (f_branch), (t_branch))))) end)))) -in (((compat && pat_t_compat)), (_174_489))) +in (((compat && pat_t_compat)), (_174_492))) end)) end)) end)) end))) true)) -in (match (_79_1648) with +in (match (_79_1658) with | (pat_t_compat, mlbranches) -> begin ( @@ -2059,33 +2071,33 @@ e end else begin ( -let _79_1652 = (FStar_Extraction_ML_UEnv.debug g (fun _79_1650 -> (let _174_492 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule e) -in (let _174_491 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t_e) -in (FStar_Util.print2 "Coercing scrutinee %s from type %s because pattern type is incompatible\n" _174_492 _174_491))))) +let _79_1662 = (FStar_Extraction_ML_UEnv.debug g (fun _79_1660 -> (let _174_495 = (FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule e) +in (let _174_494 = (FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t_e) +in (FStar_Util.print2 "Coercing scrutinee %s from type %s because pattern type is incompatible\n" _174_495 _174_494))))) in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_e) (FStar_Extraction_ML_Syntax.MLE_Coerce (((e), (t_e), (FStar_Extraction_ML_Syntax.MLTY_Top)))))) end in (match (mlbranches) with | [] -> begin ( -let _79_1661 = (let _174_494 = (let _174_493 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.failwith_lid FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Extraction_ML_UEnv.lookup_fv g _174_493)) -in (FStar_All.pipe_left FStar_Util.right _174_494)) -in (match (_79_1661) with -| (fw, _79_1658, _79_1660) -> begin -(let _174_499 = (let _174_498 = (let _174_497 = (let _174_496 = (let _174_495 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_string_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_String ("unreachable")))) -in (_174_495)::[]) -in ((fw), (_174_496))) -in FStar_Extraction_ML_Syntax.MLE_App (_174_497)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_unit_ty) _174_498)) -in ((_174_499), (FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.ml_unit_ty))) +let _79_1671 = (let _174_497 = (let _174_496 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.failwith_lid FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Extraction_ML_UEnv.lookup_fv g _174_496)) +in (FStar_All.pipe_left FStar_Util.right _174_497)) +in (match (_79_1671) with +| (fw, _79_1668, _79_1670) -> begin +(let _174_502 = (let _174_501 = (let _174_500 = (let _174_499 = (let _174_498 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_string_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_String ("unreachable")))) +in (_174_498)::[]) +in ((fw), (_174_499))) +in FStar_Extraction_ML_Syntax.MLE_App (_174_500)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_unit_ty) _174_501)) +in ((_174_502), (FStar_Extraction_ML_Syntax.E_PURE), (FStar_Extraction_ML_Syntax.ml_unit_ty))) end)) end -| ((_79_1664, _79_1666, (_79_1668, f_first, t_first)))::rest -> begin +| ((_79_1674, _79_1676, (_79_1678, f_first, t_first)))::rest -> begin ( -let _79_1694 = (FStar_List.fold_left (fun _79_1676 _79_1686 -> (match (((_79_1676), (_79_1686))) with -| ((topt, f), (_79_1678, _79_1680, (_79_1682, f_branch, t_branch))) -> begin +let _79_1704 = (FStar_List.fold_left (fun _79_1686 _79_1696 -> (match (((_79_1686), (_79_1696))) with +| ((topt, f), (_79_1688, _79_1690, (_79_1692, f_branch, t_branch))) -> begin ( let f = (FStar_Extraction_ML_Util.join top.FStar_Syntax_Syntax.pos f f_branch) @@ -2108,19 +2120,19 @@ end end) in ((topt), (f)))) end)) ((Some (t_first)), (f_first)) rest) -in (match (_79_1694) with +in (match (_79_1704) with | (topt, f_match) -> begin ( -let mlbranches = (FStar_All.pipe_right mlbranches (FStar_List.map (fun _79_1705 -> (match (_79_1705) with -| (p, (wopt, _79_1698), (b, _79_1702, t)) -> begin +let mlbranches = (FStar_All.pipe_right mlbranches (FStar_List.map (fun _79_1715 -> (match (_79_1715) with +| (p, (wopt, _79_1708), (b, _79_1712, t)) -> begin ( let b = (match (topt) with | None -> begin (FStar_Extraction_ML_Syntax.apply_obj_repr b t) end -| Some (_79_1708) -> begin +| Some (_79_1718) -> begin b end) in ((p), (wopt), (b))) @@ -2134,8 +2146,8 @@ end | Some (t) -> begin t end) -in (let _174_503 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_match) (FStar_Extraction_ML_Syntax.MLE_Match (((e), (mlbranches))))) -in ((_174_503), (f_match), (t_match))))) +in (let _174_506 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_match) (FStar_Extraction_ML_Syntax.MLE_Match (((e), (mlbranches))))) +in ((_174_506), (f_match), (t_match))))) end)) end))) end)) @@ -2150,32 +2162,32 @@ let fresh : Prims.string -> (Prims.string * Prims.int) = ( let c = (FStar_Util.mk_ref (Prims.parse_int "0")) in (fun x -> ( -let _79_1718 = (FStar_Util.incr c) -in (let _174_506 = (FStar_ST.read c) -in ((x), (_174_506)))))) +let _79_1728 = (FStar_Util.incr c) +in (let _174_509 = (FStar_ST.read c) +in ((x), (_174_509)))))) let ind_discriminator_body : FStar_Extraction_ML_UEnv.env -> FStar_Ident.lident -> FStar_Ident.lident -> FStar_Extraction_ML_Syntax.mlmodule1 = (fun env discName constrName -> ( -let _79_1726 = (FStar_TypeChecker_Env.lookup_lid env.FStar_Extraction_ML_UEnv.tcenv discName) -in (match (_79_1726) with -| (_79_1724, fstar_disc_type) -> begin +let _79_1736 = (FStar_TypeChecker_Env.lookup_lid env.FStar_Extraction_ML_UEnv.tcenv discName) +in (match (_79_1736) with +| (_79_1734, fstar_disc_type) -> begin ( -let wildcards = (match ((let _174_513 = (FStar_Syntax_Subst.compress fstar_disc_type) -in _174_513.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_arrow (binders, _79_1729) -> begin -(let _174_517 = (FStar_All.pipe_right binders (FStar_List.filter (fun _79_5 -> (match (_79_5) with -| (_79_1734, Some (FStar_Syntax_Syntax.Implicit (_79_1736))) -> begin +let wildcards = (match ((let _174_516 = (FStar_Syntax_Subst.compress fstar_disc_type) +in _174_516.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_arrow (binders, _79_1739) -> begin +(let _174_520 = (FStar_All.pipe_right binders (FStar_List.filter (fun _79_6 -> (match (_79_6) with +| (_79_1744, Some (FStar_Syntax_Syntax.Implicit (_79_1746))) -> begin true end -| _79_1741 -> begin +| _79_1751 -> begin false end)))) -in (FStar_All.pipe_right _174_517 (FStar_List.map (fun _79_1742 -> (let _174_516 = (fresh "_") -in ((_174_516), (FStar_Extraction_ML_Syntax.MLTY_Top))))))) +in (FStar_All.pipe_right _174_520 (FStar_List.map (fun _79_1752 -> (let _174_519 = (fresh "_") +in ((_174_519), (FStar_Extraction_ML_Syntax.MLTY_Top))))))) end -| _79_1745 -> begin +| _79_1755 -> begin (FStar_All.failwith "Discriminator must be a function") end) in ( @@ -2189,22 +2201,22 @@ in ( let disc_ty = FStar_Extraction_ML_Syntax.MLTY_Top in ( -let discrBody = (let _174_532 = (let _174_531 = (let _174_530 = (let _174_529 = (let _174_528 = (let _174_527 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty targ) (FStar_Extraction_ML_Syntax.MLE_Name ((([]), ((FStar_Extraction_ML_Syntax.idsym mlid)))))) -in (let _174_526 = (let _174_525 = (let _174_521 = (let _174_519 = (let _174_518 = (FStar_Extraction_ML_Syntax.mlpath_of_lident constrName) -in ((_174_518), ((FStar_Extraction_ML_Syntax.MLP_Wild)::[]))) -in FStar_Extraction_ML_Syntax.MLP_CTor (_174_519)) -in (let _174_520 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Bool (true)))) -in ((_174_521), (None), (_174_520)))) -in (let _174_524 = (let _174_523 = (let _174_522 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Bool (false)))) -in ((FStar_Extraction_ML_Syntax.MLP_Wild), (None), (_174_522))) -in (_174_523)::[]) -in (_174_525)::_174_524)) -in ((_174_527), (_174_526)))) -in FStar_Extraction_ML_Syntax.MLE_Match (_174_528)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) _174_529)) -in (((FStar_List.append wildcards ((((mlid), (targ)))::[]))), (_174_530))) -in FStar_Extraction_ML_Syntax.MLE_Fun (_174_531)) -in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty disc_ty) _174_532)) +let discrBody = (let _174_535 = (let _174_534 = (let _174_533 = (let _174_532 = (let _174_531 = (let _174_530 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty targ) (FStar_Extraction_ML_Syntax.MLE_Name ((([]), ((FStar_Extraction_ML_Syntax.idsym mlid)))))) +in (let _174_529 = (let _174_528 = (let _174_524 = (let _174_522 = (let _174_521 = (FStar_Extraction_ML_Syntax.mlpath_of_lident constrName) +in ((_174_521), ((FStar_Extraction_ML_Syntax.MLP_Wild)::[]))) +in FStar_Extraction_ML_Syntax.MLP_CTor (_174_522)) +in (let _174_523 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Bool (true)))) +in ((_174_524), (None), (_174_523)))) +in (let _174_527 = (let _174_526 = (let _174_525 = (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Bool (false)))) +in ((FStar_Extraction_ML_Syntax.MLP_Wild), (None), (_174_525))) +in (_174_526)::[]) +in (_174_528)::_174_527)) +in ((_174_530), (_174_529)))) +in FStar_Extraction_ML_Syntax.MLE_Match (_174_531)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) _174_532)) +in (((FStar_List.append wildcards ((((mlid), (targ)))::[]))), (_174_533))) +in FStar_Extraction_ML_Syntax.MLE_Fun (_174_534)) +in (FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty disc_ty) _174_535)) in FStar_Extraction_ML_Syntax.MLM_Let (((FStar_Extraction_ML_Syntax.NonRec), ([]), (({FStar_Extraction_ML_Syntax.mllb_name = (FStar_Extraction_ML_UEnv.convIdent discName.FStar_Ident.ident); FStar_Extraction_ML_Syntax.mllb_tysc = None; FStar_Extraction_ML_Syntax.mllb_add_unit = false; FStar_Extraction_ML_Syntax.mllb_def = discrBody; FStar_Extraction_ML_Syntax.print_typ = false})::[])))))))) end))) diff --git a/src/ocaml-output/FStar_Extraction_ML_UEnv.ml b/src/ocaml-output/FStar_Extraction_ML_UEnv.ml index aaebcc1387f..303ed1092dc 100755 --- a/src/ocaml-output/FStar_Extraction_ML_UEnv.ml +++ b/src/ocaml-output/FStar_Extraction_ML_UEnv.ml @@ -194,11 +194,8 @@ end | Some (mangled) -> begin ( -let _73_122 = (FStar_Util.prefix m) -in (match (_73_122) with -| (modul, _73_121) -> begin -Some (((modul), (mangled))) -end)) +let modul = m +in Some (((modul), (mangled)))) end) end else begin None @@ -219,7 +216,7 @@ let x = (FStar_Util.find_map g.gamma (fun _73_1 -> (match (_73_1) with | Fv (fv', x) when (FStar_Syntax_Syntax.fv_eq_lid fv' lid) -> begin Some (x) end -| _73_133 -> begin +| _73_130 -> begin None end))) in (match (x) with @@ -238,7 +235,7 @@ let x = (FStar_Util.find_map g.gamma (fun _73_2 -> (match (_73_2) with | Fv (fv', t) when (FStar_Syntax_Syntax.fv_eq fv fv') -> begin Some (t) end -| _73_146 -> begin +| _73_143 -> begin None end))) in (match (x) with @@ -259,7 +256,7 @@ let x = (FStar_Util.find_map g.gamma (fun _73_3 -> (match (_73_3) with | Bv (bv', r) when (FStar_Syntax_Syntax.bv_eq bv bv') -> begin Some (r) end -| _73_159 -> begin +| _73_156 -> begin None end))) in (match (x) with @@ -292,7 +289,7 @@ end | FStar_Syntax_Syntax.Tm_fvar (x) -> begin (lookup g (FStar_Util.Inr (x))) end -| _73_177 -> begin +| _73_174 -> begin (FStar_All.failwith "Impossible: lookup_term for a non-name") end)) @@ -317,8 +314,8 @@ in ( let tcenv = (FStar_TypeChecker_Env.push_bv g.tcenv a) in ( -let _73_188 = g -in {tcenv = tcenv; gamma = gamma; tydefs = _73_188.tydefs; currentModule = _73_188.currentModule})))))) +let _73_185 = g +in {tcenv = tcenv; gamma = gamma; tydefs = _73_185.tydefs; currentModule = _73_185.currentModule})))))) let extend_bv : env -> FStar_Syntax_Syntax.bv -> FStar_Extraction_ML_Syntax.mltyscheme -> Prims.bool -> Prims.bool -> Prims.bool -> env = (fun g x t_x add_unit is_rec mk_unit -> ( @@ -327,7 +324,7 @@ let ml_ty = (match (t_x) with | ([], t) -> begin t end -| _73_200 -> begin +| _73_197 -> begin FStar_Extraction_ML_Syntax.MLTY_Top end) in ( @@ -354,8 +351,8 @@ let tcenv = (let _168_145 = (FStar_Syntax_Syntax.binders_of_list ((x)::[])) in (FStar_TypeChecker_Env.push_binders g.tcenv _168_145)) in ( -let _73_206 = g -in {tcenv = tcenv; gamma = gamma; tydefs = _73_206.tydefs; currentModule = _73_206.currentModule}))))))) +let _73_203 = g +in {tcenv = tcenv; gamma = gamma; tydefs = _73_203.tydefs; currentModule = _73_203.currentModule}))))))) let rec mltyFvars : FStar_Extraction_ML_Syntax.mlty -> FStar_Extraction_ML_Syntax.mlident Prims.list = (fun t -> (match (t) with @@ -398,15 +395,15 @@ let ml_ty = (match (t_x) with | ([], t) -> begin t end -| _73_240 -> begin +| _73_237 -> begin FStar_Extraction_ML_Syntax.MLTY_Top end) in ( let mly = FStar_Extraction_ML_Syntax.MLE_Name (( -let _73_244 = y -in (match (_73_244) with +let _73_241 = y +in (match (_73_241) with | (ns, i) -> begin ((ns), ((FStar_Extraction_ML_Syntax.avoid_keyword i))) end))) @@ -422,8 +419,8 @@ in ( let gamma = (Fv (((x), (FStar_Util.Inr (((mly), (t_x), (is_rec)))))))::g.gamma in ( -let _73_248 = g -in {tcenv = _73_248.tcenv; gamma = gamma; tydefs = _73_248.tydefs; currentModule = _73_248.currentModule}))))) +let _73_245 = g +in {tcenv = _73_245.tcenv; gamma = gamma; tydefs = _73_245.tydefs; currentModule = _73_245.currentModule}))))) end else begin (FStar_All.failwith "freevars found") end) @@ -444,8 +441,8 @@ end | FStar_Util.Inr (f) -> begin ( -let _73_268 = (FStar_Extraction_ML_Syntax.mlpath_of_lident f.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) -in (match (_73_268) with +let _73_265 = (FStar_Extraction_ML_Syntax.mlpath_of_lident f.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) +in (match (_73_265) with | (p, y) -> begin (let _168_193 = (extend_fv' g f ((p), (y)) t_x add_unit is_rec) in ((_168_193), ((((FStar_Extraction_ML_Syntax.avoid_keyword y)), ((Prims.parse_int "0")))))) @@ -458,8 +455,8 @@ let extend_tydef : env -> FStar_Syntax_Syntax.fv -> FStar_Extraction_ML_Synt let m = (module_name_of_fv fv) in ( -let _73_273 = g -in {tcenv = _73_273.tcenv; gamma = _73_273.gamma; tydefs = (((m), (td)))::g.tydefs; currentModule = _73_273.currentModule}))) +let _73_270 = g +in {tcenv = _73_270.tcenv; gamma = _73_270.gamma; tydefs = (((m), (td)))::g.tydefs; currentModule = _73_270.currentModule}))) let emptyMlPath : (Prims.string Prims.list * Prims.string) = (([]), ("")) @@ -482,8 +479,8 @@ in (FStar_All.pipe_right _168_204 Prims.fst)))))) let monad_op_name : FStar_Syntax_Syntax.eff_decl -> Prims.string -> ((Prims.string Prims.list * Prims.string) * FStar_Ident.lident) = (fun ed nm -> ( -let _73_283 = ((ed.FStar_Syntax_Syntax.mname.FStar_Ident.ns), (ed.FStar_Syntax_Syntax.mname.FStar_Ident.ident)) -in (match (_73_283) with +let _73_280 = ((ed.FStar_Syntax_Syntax.mname.FStar_Ident.ns), (ed.FStar_Syntax_Syntax.mname.FStar_Ident.ident)) +in (match (_73_280) with | (module_name, eff_name) -> begin ( diff --git a/src/ocaml-output/FStar_FStar.ml b/src/ocaml-output/FStar_FStar.ml index 4267b26dba5..6ecbcd6d9ae 100755 --- a/src/ocaml-output/FStar_FStar.ml +++ b/src/ocaml-output/FStar_FStar.ml @@ -121,21 +121,20 @@ in (match (opt) with let newDocs = (FStar_List.collect FStar_Extraction_ML_Code.doc_of_mllib mllibs) in (FStar_List.iter (fun _94_46 -> (match (_94_46) with | (n, d) -> begin -(let _189_28 = (FStar_Options.prepend_output_dir (Prims.strcat n ext)) -in (let _189_27 = (FStar_Format.pretty (Prims.parse_int "120") d) -in (FStar_Util.write_file _189_28 _189_27))) +(let _189_27 = (FStar_Options.prepend_output_dir (Prims.strcat n ext)) +in (FStar_Util.write_file _189_27 (FStar_Format.pretty (Prims.parse_int "120") d))) end)) newDocs)) end | Some ("Kremlin") -> begin ( -let programs = (let _189_29 = (FStar_List.map FStar_Extraction_Kremlin.translate mllibs) -in (FStar_List.flatten _189_29)) +let programs = (let _189_28 = (FStar_List.map FStar_Extraction_Kremlin.translate mllibs) +in (FStar_List.flatten _189_28)) in ( let bin = ((FStar_Extraction_Kremlin.current_version), (programs)) -in (let _189_30 = (FStar_Options.prepend_output_dir "out.krml") -in (FStar_Util.save_value_to_file _189_30 bin)))) +in (let _189_29 = (FStar_Options.prepend_output_dir "out.krml") +in (FStar_Util.save_value_to_file _189_29 bin)))) end | _94_52 -> begin (FStar_All.failwith "Unrecognized option") @@ -162,8 +161,8 @@ end end | FStar_Getopt.Success -> begin if ((FStar_Options.dep ()) <> None) then begin -(let _189_32 = (FStar_Parser_Dep.collect FStar_Parser_Dep.VerifyAll filenames) -in (FStar_Parser_Dep.print _189_32)) +(let _189_31 = (FStar_Parser_Dep.collect FStar_Parser_Dep.VerifyAll filenames) +in (FStar_Parser_Dep.print _189_31)) end else begin if (FStar_Options.interactive ()) then begin ( @@ -256,10 +255,10 @@ in ( let _94_95 = (report_errors module_names_and_times) in ( -let _94_97 = (let _189_36 = (let _189_35 = (let _189_34 = (FStar_All.pipe_right fmods (FStar_List.map Prims.fst)) -in ((_189_34), (env))) -in FStar_Util.Inr (_189_35)) -in (codegen _189_36)) +let _94_97 = (let _189_35 = (let _189_34 = (let _189_33 = (FStar_All.pipe_right fmods (FStar_List.map Prims.fst)) +in ((_189_33), (env))) +in FStar_Util.Inr (_189_34)) +in (codegen _189_35)) in (finished_message module_names_and_times (Prims.parse_int "0"))))) end)) end else begin @@ -279,10 +278,10 @@ in ( let _94_107 = (report_errors module_names_and_times) in ( -let _94_109 = (let _189_40 = (let _189_39 = (let _189_38 = (FStar_All.pipe_right fmods (FStar_List.map Prims.fst)) -in ((_189_38), (env))) -in FStar_Util.Inl (_189_39)) -in (codegen _189_40)) +let _94_109 = (let _189_39 = (let _189_38 = (let _189_37 = (FStar_All.pipe_right fmods (FStar_List.map Prims.fst)) +in ((_189_37), (env))) +in FStar_Util.Inl (_189_38)) +in (codegen _189_39)) in (finished_message module_names_and_times (Prims.parse_int "0"))))) end)) end) @@ -328,13 +327,13 @@ end else begin () end in if (FStar_Options.trace_error ()) then begin -(let _189_45 = (FStar_Util.message_of_exn e) -in (let _189_44 = (FStar_Util.trace_of_exn e) -in (FStar_Util.print2_error "Unexpected error\n%s\n%s\n" _189_45 _189_44))) +(let _189_44 = (FStar_Util.message_of_exn e) +in (let _189_43 = (FStar_Util.trace_of_exn e) +in (FStar_Util.print2_error "Unexpected error\n%s\n%s\n" _189_44 _189_43))) end else begin if (not (((FStar_Absyn_Util.handleable e) || (FStar_TypeChecker_Errors.handleable e)))) then begin -(let _189_46 = (FStar_Util.message_of_exn e) -in (FStar_Util.print1_error "Unexpected error; please file a bug report, ideally with a minimized version of the source program that triggered the error.\n%s\n" _189_46)) +(let _189_45 = (FStar_Util.message_of_exn e) +in (FStar_Util.print1_error "Unexpected error; please file a bug report, ideally with a minimized version of the source program that triggered the error.\n%s\n" _189_45)) end else begin () end @@ -344,8 +343,8 @@ in ( let _94_122 = (cleanup ()) in ( -let _94_124 = (let _189_47 = (FStar_TypeChecker_Errors.report_all ()) -in (FStar_All.pipe_right _189_47 Prims.ignore)) +let _94_124 = (let _189_46 = (FStar_TypeChecker_Errors.report_all ()) +in (FStar_All.pipe_right _189_46 Prims.ignore)) in ( let _94_126 = (report_errors []) diff --git a/src/ocaml-output/FStar_Format.ml b/src/ocaml-output/FStar_Format.ml index 64c09d0caa6..4e460f04b97 100755 --- a/src/ocaml-output/FStar_Format.ml +++ b/src/ocaml-output/FStar_Format.ml @@ -49,25 +49,19 @@ end)) let brackets : doc -> doc = (fun _27_13 -> (match (_27_13) with | Doc (d) -> begin -(let _122_22 = (text "[") -in (let _122_21 = (text "]") -in (enclose _122_22 _122_21 (Doc (d))))) +(enclose (text "[") (text "]") (Doc (d))) end)) let cbrackets : doc -> doc = (fun _27_15 -> (match (_27_15) with | Doc (d) -> begin -(let _122_26 = (text "{") -in (let _122_25 = (text "}") -in (enclose _122_26 _122_25 (Doc (d))))) +(enclose (text "{") (text "}") (Doc (d))) end)) let parens : doc -> doc = (fun _27_17 -> (match (_27_17) with | Doc (d) -> begin -(let _122_30 = (text "(") -in (let _122_29 = (text ")") -in (enclose _122_30 _122_29 (Doc (d))))) +(enclose (text "(") (text ")") (Doc (d))) end)) @@ -86,8 +80,8 @@ Doc (d) end)) -let groups : doc Prims.list -> doc = (fun docs -> (let _122_41 = (reduce docs) -in (group _122_41))) +let groups : doc Prims.list -> doc = (fun docs -> (let _122_35 = (reduce docs) +in (group _122_35))) let combine : doc -> doc Prims.list -> doc = (fun _27_27 docs -> (match (_27_27) with diff --git a/src/ocaml-output/FStar_Parser_AST.ml b/src/ocaml-output/FStar_Parser_AST.ml index 8012a5788d7..0bc9f6535d9 100755 --- a/src/ocaml-output/FStar_Parser_AST.ml +++ b/src/ocaml-output/FStar_Parser_AST.ml @@ -154,6 +154,7 @@ type term' = | Tvar of FStar_Ident.ident | Var of FStar_Ident.lid | Name of FStar_Ident.lid +| Projector of (FStar_Ident.lid * FStar_Ident.ident) | Construct of (FStar_Ident.lid * (term * imp) Prims.list) | Abs of (pattern Prims.list * term) | App of (term * term * imp) @@ -176,7 +177,8 @@ type term' = | Requires of (term * Prims.string Prims.option) | Ensures of (term * Prims.string Prims.option) | Labeled of (term * Prims.string * Prims.bool) -| Assign of (FStar_Ident.ident * term) +| Assign of (FStar_Ident.ident * term) +| Discrim of FStar_Ident.lid and term = {tm : term'; range : FStar_Range.range; level : level} and binder' = @@ -260,6 +262,15 @@ false end)) +let is_Projector = (fun _discr_ -> (match (_discr_) with +| Projector (_) -> begin +true +end +| _ -> begin +false +end)) + + let is_Construct = (fun _discr_ -> (match (_discr_) with | Construct (_) -> begin true @@ -467,6 +478,15 @@ false end)) +let is_Discrim = (fun _discr_ -> (match (_discr_) with +| Discrim (_) -> begin +true +end +| _ -> begin +false +end)) + + let is_Mkterm : term -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwith "Not yet implemented:is_Mkterm")))) @@ -659,237 +679,249 @@ _60_28 end)) -let ___Construct____0 = (fun projectee -> (match (projectee) with -| Construct (_60_31) -> begin +let ___Projector____0 = (fun projectee -> (match (projectee) with +| Projector (_60_31) -> begin _60_31 end)) -let ___Abs____0 = (fun projectee -> (match (projectee) with -| Abs (_60_34) -> begin +let ___Construct____0 = (fun projectee -> (match (projectee) with +| Construct (_60_34) -> begin _60_34 end)) -let ___App____0 = (fun projectee -> (match (projectee) with -| App (_60_37) -> begin +let ___Abs____0 = (fun projectee -> (match (projectee) with +| Abs (_60_37) -> begin _60_37 end)) -let ___Let____0 = (fun projectee -> (match (projectee) with -| Let (_60_40) -> begin +let ___App____0 = (fun projectee -> (match (projectee) with +| App (_60_40) -> begin _60_40 end)) -let ___LetOpen____0 = (fun projectee -> (match (projectee) with -| LetOpen (_60_43) -> begin +let ___Let____0 = (fun projectee -> (match (projectee) with +| Let (_60_43) -> begin _60_43 end)) -let ___Seq____0 = (fun projectee -> (match (projectee) with -| Seq (_60_46) -> begin +let ___LetOpen____0 = (fun projectee -> (match (projectee) with +| LetOpen (_60_46) -> begin _60_46 end)) -let ___If____0 = (fun projectee -> (match (projectee) with -| If (_60_49) -> begin +let ___Seq____0 = (fun projectee -> (match (projectee) with +| Seq (_60_49) -> begin _60_49 end)) -let ___Match____0 = (fun projectee -> (match (projectee) with -| Match (_60_52) -> begin +let ___If____0 = (fun projectee -> (match (projectee) with +| If (_60_52) -> begin _60_52 end)) -let ___TryWith____0 = (fun projectee -> (match (projectee) with -| TryWith (_60_55) -> begin +let ___Match____0 = (fun projectee -> (match (projectee) with +| Match (_60_55) -> begin _60_55 end)) -let ___Ascribed____0 = (fun projectee -> (match (projectee) with -| Ascribed (_60_58) -> begin +let ___TryWith____0 = (fun projectee -> (match (projectee) with +| TryWith (_60_58) -> begin _60_58 end)) -let ___Record____0 = (fun projectee -> (match (projectee) with -| Record (_60_61) -> begin +let ___Ascribed____0 = (fun projectee -> (match (projectee) with +| Ascribed (_60_61) -> begin _60_61 end)) -let ___Project____0 = (fun projectee -> (match (projectee) with -| Project (_60_64) -> begin +let ___Record____0 = (fun projectee -> (match (projectee) with +| Record (_60_64) -> begin _60_64 end)) -let ___Product____0 = (fun projectee -> (match (projectee) with -| Product (_60_67) -> begin +let ___Project____0 = (fun projectee -> (match (projectee) with +| Project (_60_67) -> begin _60_67 end)) -let ___Sum____0 = (fun projectee -> (match (projectee) with -| Sum (_60_70) -> begin +let ___Product____0 = (fun projectee -> (match (projectee) with +| Product (_60_70) -> begin _60_70 end)) -let ___QForall____0 = (fun projectee -> (match (projectee) with -| QForall (_60_73) -> begin +let ___Sum____0 = (fun projectee -> (match (projectee) with +| Sum (_60_73) -> begin _60_73 end)) -let ___QExists____0 = (fun projectee -> (match (projectee) with -| QExists (_60_76) -> begin +let ___QForall____0 = (fun projectee -> (match (projectee) with +| QForall (_60_76) -> begin _60_76 end)) -let ___Refine____0 = (fun projectee -> (match (projectee) with -| Refine (_60_79) -> begin +let ___QExists____0 = (fun projectee -> (match (projectee) with +| QExists (_60_79) -> begin _60_79 end)) -let ___NamedTyp____0 = (fun projectee -> (match (projectee) with -| NamedTyp (_60_82) -> begin +let ___Refine____0 = (fun projectee -> (match (projectee) with +| Refine (_60_82) -> begin _60_82 end)) -let ___Paren____0 = (fun projectee -> (match (projectee) with -| Paren (_60_85) -> begin +let ___NamedTyp____0 = (fun projectee -> (match (projectee) with +| NamedTyp (_60_85) -> begin _60_85 end)) -let ___Requires____0 = (fun projectee -> (match (projectee) with -| Requires (_60_88) -> begin +let ___Paren____0 = (fun projectee -> (match (projectee) with +| Paren (_60_88) -> begin _60_88 end)) -let ___Ensures____0 = (fun projectee -> (match (projectee) with -| Ensures (_60_91) -> begin +let ___Requires____0 = (fun projectee -> (match (projectee) with +| Requires (_60_91) -> begin _60_91 end)) -let ___Labeled____0 = (fun projectee -> (match (projectee) with -| Labeled (_60_94) -> begin +let ___Ensures____0 = (fun projectee -> (match (projectee) with +| Ensures (_60_94) -> begin _60_94 end)) -let ___Assign____0 = (fun projectee -> (match (projectee) with -| Assign (_60_97) -> begin +let ___Labeled____0 = (fun projectee -> (match (projectee) with +| Labeled (_60_97) -> begin _60_97 end)) +let ___Assign____0 = (fun projectee -> (match (projectee) with +| Assign (_60_100) -> begin +_60_100 +end)) + + +let ___Discrim____0 = (fun projectee -> (match (projectee) with +| Discrim (_60_103) -> begin +_60_103 +end)) + + let ___Variable____0 = (fun projectee -> (match (projectee) with -| Variable (_60_101) -> begin -_60_101 +| Variable (_60_107) -> begin +_60_107 end)) let ___TVariable____0 = (fun projectee -> (match (projectee) with -| TVariable (_60_104) -> begin -_60_104 +| TVariable (_60_110) -> begin +_60_110 end)) let ___Annotated____0 = (fun projectee -> (match (projectee) with -| Annotated (_60_107) -> begin -_60_107 +| Annotated (_60_113) -> begin +_60_113 end)) let ___TAnnotated____0 = (fun projectee -> (match (projectee) with -| TAnnotated (_60_110) -> begin -_60_110 +| TAnnotated (_60_116) -> begin +_60_116 end)) let ___NoName____0 = (fun projectee -> (match (projectee) with -| NoName (_60_113) -> begin -_60_113 +| NoName (_60_119) -> begin +_60_119 end)) let ___PatConst____0 = (fun projectee -> (match (projectee) with -| PatConst (_60_117) -> begin -_60_117 +| PatConst (_60_123) -> begin +_60_123 end)) let ___PatApp____0 = (fun projectee -> (match (projectee) with -| PatApp (_60_120) -> begin -_60_120 +| PatApp (_60_126) -> begin +_60_126 end)) let ___PatVar____0 = (fun projectee -> (match (projectee) with -| PatVar (_60_123) -> begin -_60_123 +| PatVar (_60_129) -> begin +_60_129 end)) let ___PatName____0 = (fun projectee -> (match (projectee) with -| PatName (_60_126) -> begin -_60_126 +| PatName (_60_132) -> begin +_60_132 end)) let ___PatTvar____0 = (fun projectee -> (match (projectee) with -| PatTvar (_60_129) -> begin -_60_129 +| PatTvar (_60_135) -> begin +_60_135 end)) let ___PatList____0 = (fun projectee -> (match (projectee) with -| PatList (_60_132) -> begin -_60_132 +| PatList (_60_138) -> begin +_60_138 end)) let ___PatTuple____0 = (fun projectee -> (match (projectee) with -| PatTuple (_60_135) -> begin -_60_135 +| PatTuple (_60_141) -> begin +_60_141 end)) let ___PatRecord____0 = (fun projectee -> (match (projectee) with -| PatRecord (_60_138) -> begin -_60_138 +| PatRecord (_60_144) -> begin +_60_144 end)) let ___PatAscribed____0 = (fun projectee -> (match (projectee) with -| PatAscribed (_60_141) -> begin -_60_141 +| PatAscribed (_60_147) -> begin +_60_147 end)) let ___PatOr____0 = (fun projectee -> (match (projectee) with -| PatOr (_60_144) -> begin -_60_144 +| PatOr (_60_150) -> begin +_60_150 end)) let ___PatOp____0 = (fun projectee -> (match (projectee) with -| PatOp (_60_147) -> begin -_60_147 +| PatOp (_60_153) -> begin +_60_153 end)) @@ -953,26 +985,26 @@ end)) let ___TyconAbstract____0 = (fun projectee -> (match (projectee) with -| TyconAbstract (_60_151) -> begin -_60_151 +| TyconAbstract (_60_157) -> begin +_60_157 end)) let ___TyconAbbrev____0 = (fun projectee -> (match (projectee) with -| TyconAbbrev (_60_154) -> begin -_60_154 +| TyconAbbrev (_60_160) -> begin +_60_160 end)) let ___TyconRecord____0 = (fun projectee -> (match (projectee) with -| TyconRecord (_60_157) -> begin -_60_157 +| TyconRecord (_60_163) -> begin +_60_163 end)) let ___TyconVariant____0 = (fun projectee -> (match (projectee) with -| TyconVariant (_60_160) -> begin -_60_160 +| TyconVariant (_60_166) -> begin +_60_166 end)) @@ -1197,20 +1229,20 @@ end)) let ___NonReifiableLift____0 = (fun projectee -> (match (projectee) with -| NonReifiableLift (_60_163) -> begin -_60_163 +| NonReifiableLift (_60_169) -> begin +_60_169 end)) let ___ReifiableLift____0 = (fun projectee -> (match (projectee) with -| ReifiableLift (_60_166) -> begin -_60_166 +| ReifiableLift (_60_172) -> begin +_60_172 end)) let ___LiftForFree____0 = (fun projectee -> (match (projectee) with -| LiftForFree (_60_169) -> begin -_60_169 +| LiftForFree (_60_175) -> begin +_60_175 end)) @@ -1245,14 +1277,14 @@ end)) let ___SetOptions____0 = (fun projectee -> (match (projectee) with -| SetOptions (_60_176) -> begin -_60_176 +| SetOptions (_60_182) -> begin +_60_182 end)) let ___ResetOptions____0 = (fun projectee -> (match (projectee) with -| ResetOptions (_60_179) -> begin -_60_179 +| ResetOptions (_60_185) -> begin +_60_185 end)) @@ -1436,104 +1468,104 @@ end)) let ___TopLevelModule____0 = (fun projectee -> (match (projectee) with -| TopLevelModule (_60_185) -> begin -_60_185 +| TopLevelModule (_60_191) -> begin +_60_191 end)) let ___Open____0 = (fun projectee -> (match (projectee) with -| Open (_60_188) -> begin -_60_188 +| Open (_60_194) -> begin +_60_194 end)) let ___ModuleAbbrev____0 = (fun projectee -> (match (projectee) with -| ModuleAbbrev (_60_191) -> begin -_60_191 +| ModuleAbbrev (_60_197) -> begin +_60_197 end)) let ___KindAbbrev____0 = (fun projectee -> (match (projectee) with -| KindAbbrev (_60_194) -> begin -_60_194 +| KindAbbrev (_60_200) -> begin +_60_200 end)) let ___TopLevelLet____0 = (fun projectee -> (match (projectee) with -| TopLevelLet (_60_197) -> begin -_60_197 +| TopLevelLet (_60_203) -> begin +_60_203 end)) let ___Main____0 = (fun projectee -> (match (projectee) with -| Main (_60_200) -> begin -_60_200 +| Main (_60_206) -> begin +_60_206 end)) let ___Assume____0 = (fun projectee -> (match (projectee) with -| Assume (_60_203) -> begin -_60_203 +| Assume (_60_209) -> begin +_60_209 end)) let ___Tycon____0 = (fun projectee -> (match (projectee) with -| Tycon (_60_206) -> begin -_60_206 +| Tycon (_60_212) -> begin +_60_212 end)) let ___Val____0 = (fun projectee -> (match (projectee) with -| Val (_60_209) -> begin -_60_209 +| Val (_60_215) -> begin +_60_215 end)) let ___Exception____0 = (fun projectee -> (match (projectee) with -| Exception (_60_212) -> begin -_60_212 +| Exception (_60_218) -> begin +_60_218 end)) let ___NewEffect____0 = (fun projectee -> (match (projectee) with -| NewEffect (_60_215) -> begin -_60_215 +| NewEffect (_60_221) -> begin +_60_221 end)) let ___NewEffectForFree____0 = (fun projectee -> (match (projectee) with -| NewEffectForFree (_60_218) -> begin -_60_218 +| NewEffectForFree (_60_224) -> begin +_60_224 end)) let ___SubEffect____0 = (fun projectee -> (match (projectee) with -| SubEffect (_60_221) -> begin -_60_221 +| SubEffect (_60_227) -> begin +_60_227 end)) let ___Pragma____0 = (fun projectee -> (match (projectee) with -| Pragma (_60_224) -> begin -_60_224 +| Pragma (_60_230) -> begin +_60_230 end)) let ___Fsdoc____0 = (fun projectee -> (match (projectee) with -| Fsdoc (_60_227) -> begin -_60_227 +| Fsdoc (_60_233) -> begin +_60_233 end)) let ___DefineEffect____0 = (fun projectee -> (match (projectee) with -| DefineEffect (_60_231) -> begin -_60_231 +| DefineEffect (_60_237) -> begin +_60_237 end)) let ___RedefineEffect____0 = (fun projectee -> (match (projectee) with -| RedefineEffect (_60_234) -> begin -_60_234 +| RedefineEffect (_60_240) -> begin +_60_240 end)) @@ -1561,14 +1593,14 @@ end)) let ___Module____0 = (fun projectee -> (match (projectee) with -| Module (_60_237) -> begin -_60_237 +| Module (_60_243) -> begin +_60_243 end)) let ___Interface____0 = (fun projectee -> (match (projectee) with -| Interface (_60_240) -> begin -_60_240 +| Interface (_60_246) -> begin +_60_246 end)) @@ -1587,10 +1619,10 @@ let first_char = (FStar_String.substring id.FStar_Ident.idText (Prims.parse_int in if ((FStar_String.lowercase first_char) = first_char) then begin () end else begin -(let _155_1096 = (let _155_1095 = (let _155_1094 = (FStar_Util.format1 "Invalid identifer \'%s\'; expected a symbol that begins with a lower-case character" id.FStar_Ident.idText) -in ((_155_1094), (id.FStar_Ident.idRange))) -in FStar_Syntax_Syntax.Error (_155_1095)) -in (Prims.raise _155_1096)) +(let _155_1124 = (let _155_1123 = (let _155_1122 = (FStar_Util.format1 "Invalid identifer \'%s\'; expected a symbol that begins with a lower-case character" id.FStar_Ident.idText) +in ((_155_1122), (id.FStar_Ident.idRange))) +in FStar_Syntax_Syntax.Error (_155_1123)) +in (Prims.raise _155_1124)) end) end else begin () @@ -1612,7 +1644,7 @@ let t = (match (t.tm) with | Const (FStar_Const.Const_int (s, Some (FStar_Const.Signed, width))) -> begin Const (FStar_Const.Const_int ((((Prims.strcat "-" s)), (Some (((FStar_Const.Signed), (width))))))) end -| _60_265 -> begin +| _60_271 -> begin Op ((("-"), ((t)::[]))) end) in (mk_term t r l))) @@ -1625,7 +1657,7 @@ let un_curry_abs : pattern Prims.list -> term -> term' = (fun ps body -> (ma | Abs (p', body') -> begin Abs ((((FStar_List.append ps p')), (body'))) end -| _60_276 -> begin +| _60_282 -> begin Abs (((ps), (body))) end)) @@ -1640,28 +1672,28 @@ in (FStar_Ident.gen r1)) end else begin (FStar_Absyn_Util.genident (Some (r1))) end -in (let _155_1144 = (let _155_1143 = (let _155_1142 = (let _155_1141 = (let _155_1140 = (let _155_1139 = (let _155_1138 = (let _155_1137 = (FStar_Ident.lid_of_ids ((x)::[])) -in Var (_155_1137)) -in (mk_term _155_1138 r1 Expr)) -in ((_155_1139), (branches))) -in Match (_155_1140)) -in (mk_term _155_1141 r2 Expr)) -in ((((mk_pattern (PatVar (((x), (None)))) r1))::[]), (_155_1142))) -in Abs (_155_1143)) -in (mk_term _155_1144 r2 Expr)))) +in (let _155_1172 = (let _155_1171 = (let _155_1170 = (let _155_1169 = (let _155_1168 = (let _155_1167 = (let _155_1166 = (let _155_1165 = (FStar_Ident.lid_of_ids ((x)::[])) +in Var (_155_1165)) +in (mk_term _155_1166 r1 Expr)) +in ((_155_1167), (branches))) +in Match (_155_1168)) +in (mk_term _155_1169 r2 Expr)) +in ((((mk_pattern (PatVar (((x), (None)))) r1))::[]), (_155_1170))) +in Abs (_155_1171)) +in (mk_term _155_1172 r2 Expr)))) let un_function : pattern -> term -> (pattern * term) Prims.option = (fun p tm -> (match (((p.pat), (tm.tm))) with -| (PatVar (_60_285), Abs (pats, body)) -> begin +| (PatVar (_60_291), Abs (pats, body)) -> begin Some ((((mk_pattern (PatApp (((p), (pats)))) p.prange)), (body))) end -| _60_293 -> begin +| _60_299 -> begin None end)) -let lid_with_range : FStar_Ident.lident -> FStar_Range.range -> FStar_Ident.lident = (fun lid r -> (let _155_1153 = (FStar_Ident.path_of_lid lid) -in (FStar_Ident.lid_of_path _155_1153 r))) +let lid_with_range : FStar_Ident.lident -> FStar_Range.range -> FStar_Ident.lident = (fun lid r -> (let _155_1181 = (FStar_Ident.path_of_lid lid) +in (FStar_Ident.lid_of_path _155_1181 r))) let consPat : FStar_Range.range -> pattern -> pattern -> pattern' = (fun r hd tl -> PatApp ((((mk_pattern (PatName (FStar_Absyn_Const.cons_lid)) r)), ((hd)::(tl)::[])))) @@ -1689,13 +1721,13 @@ let mkApp : term -> (term * imp) Prims.list -> FStar_Range.range -> term = | [] -> begin t end -| _60_320 -> begin +| _60_326 -> begin (match (t.tm) with | Name (s) -> begin (mk_term (Construct (((s), (args)))) r Un) end -| _60_324 -> begin -(FStar_List.fold_left (fun t _60_328 -> (match (_60_328) with +| _60_330 -> begin +(FStar_List.fold_left (fun t _60_334 -> (match (_60_334) with | (a, imp) -> begin (mk_term (App (((t), (a), (imp)))) r Un) end)) t args) @@ -1708,12 +1740,12 @@ let mkRefSet : FStar_Range.range -> term Prims.list -> term = (fun r elts -> let univs = (FStar_Options.universes ()) in ( -let _60_335 = if univs then begin +let _60_341 = if univs then begin ((FStar_Absyn_Const.tset_empty), (FStar_Absyn_Const.tset_singleton), (FStar_Absyn_Const.tset_union)) end else begin ((FStar_Absyn_Const.set_empty), (FStar_Absyn_Const.set_singleton), (FStar_Absyn_Const.set_union)) end -in (match (_60_335) with +in (match (_60_341) with | (empty_lid, singleton_lid, union_lid) -> begin ( @@ -1741,15 +1773,15 @@ let mkExplicitApp : term -> term Prims.list -> FStar_Range.range -> term = | [] -> begin t end -| _60_349 -> begin +| _60_355 -> begin (match (t.tm) with | Name (s) -> begin -(let _155_1207 = (let _155_1206 = (let _155_1205 = (FStar_List.map (fun a -> ((a), (Nothing))) args) -in ((s), (_155_1205))) -in Construct (_155_1206)) -in (mk_term _155_1207 r Un)) +(let _155_1235 = (let _155_1234 = (let _155_1233 = (FStar_List.map (fun a -> ((a), (Nothing))) args) +in ((s), (_155_1233))) +in Construct (_155_1234)) +in (mk_term _155_1235 r Un)) end -| _60_354 -> begin +| _60_360 -> begin (FStar_List.fold_left (fun t a -> (mk_term (App (((t), (a), (Nothing)))) r Un)) t args) end) end)) @@ -1776,8 +1808,8 @@ let admit_magic = (mk_term (Seq (((admit), (magic)))) r Expr) in admit_magic))))) -let mkWildAdmitMagic = (fun r -> (let _155_1213 = (mkAdmitMagic r) -in (((mk_pattern PatWild r)), (None), (_155_1213)))) +let mkWildAdmitMagic = (fun r -> (let _155_1241 = (mkAdmitMagic r) +in (((mk_pattern PatWild r)), (None), (_155_1241)))) let focusBranches = (fun branches r -> ( @@ -1786,14 +1818,14 @@ let should_filter = (FStar_Util.for_some Prims.fst branches) in if should_filter then begin ( -let _60_368 = (FStar_Tc_Errors.warn r "Focusing on only some cases") +let _60_374 = (FStar_Tc_Errors.warn r "Focusing on only some cases") in ( -let focussed = (let _155_1216 = (FStar_List.filter Prims.fst branches) -in (FStar_All.pipe_right _155_1216 (FStar_List.map Prims.snd))) -in (let _155_1218 = (let _155_1217 = (mkWildAdmitMagic r) -in (_155_1217)::[]) -in (FStar_List.append focussed _155_1218)))) +let focussed = (let _155_1244 = (FStar_List.filter Prims.fst branches) +in (FStar_All.pipe_right _155_1244 (FStar_List.map Prims.snd))) +in (let _155_1246 = (let _155_1245 = (mkWildAdmitMagic r) +in (_155_1245)::[]) +in (FStar_List.append focussed _155_1246)))) end else begin (FStar_All.pipe_right branches (FStar_List.map Prims.snd)) end)) @@ -1805,14 +1837,14 @@ let should_filter = (FStar_Util.for_some Prims.fst lbs) in if should_filter then begin ( -let _60_374 = (FStar_Tc_Errors.warn r "Focusing on only some cases in this (mutually) recursive definition") -in (FStar_List.map (fun _60_378 -> (match (_60_378) with +let _60_380 = (FStar_Tc_Errors.warn r "Focusing on only some cases in this (mutually) recursive definition") +in (FStar_List.map (fun _60_384 -> (match (_60_384) with | (f, lb) -> begin if f then begin lb end else begin -(let _155_1222 = (mkAdmitMagic r) -in (((Prims.fst lb)), (_155_1222))) +(let _155_1250 = (mkAdmitMagic r) +in (((Prims.fst lb)), (_155_1250))) end end)) lbs)) end else begin @@ -1820,8 +1852,8 @@ end else begin end)) -let mkFsTypApp : term -> term Prims.list -> FStar_Range.range -> term = (fun t args r -> (let _155_1230 = (FStar_List.map (fun a -> ((a), (FsTypApp))) args) -in (mkApp t _155_1230 r))) +let mkFsTypApp : term -> term Prims.list -> FStar_Range.range -> term = (fun t args r -> (let _155_1258 = (FStar_List.map (fun a -> ((a), (FsTypApp))) args) +in (mkApp t _155_1258 r))) let mkTuple : term Prims.list -> FStar_Range.range -> term = (fun args r -> ( @@ -1831,8 +1863,8 @@ let cons = if (FStar_Options.universes ()) then begin end else begin (FStar_Absyn_Util.mk_tuple_data_lid (FStar_List.length args) r) end -in (let _155_1236 = (FStar_List.map (fun x -> ((x), (Nothing))) args) -in (mkApp (mk_term (Name (cons)) r Expr) _155_1236 r)))) +in (let _155_1264 = (FStar_List.map (fun x -> ((x), (Nothing))) args) +in (mkApp (mk_term (Name (cons)) r Expr) _155_1264 r)))) let mkDTuple : term Prims.list -> FStar_Range.range -> term = (fun args r -> ( @@ -1842,8 +1874,8 @@ let cons = if (FStar_Options.universes ()) then begin end else begin (FStar_Absyn_Util.mk_dtuple_data_lid (FStar_List.length args) r) end -in (let _155_1242 = (FStar_List.map (fun x -> ((x), (Nothing))) args) -in (mkApp (mk_term (Name (cons)) r Expr) _155_1242 r)))) +in (let _155_1270 = (FStar_List.map (fun x -> ((x), (Nothing))) args) +in (mkApp (mk_term (Name (cons)) r Expr) _155_1270 r)))) let mkRefinedBinder : FStar_Ident.ident -> term -> Prims.bool -> term Prims.option -> FStar_Range.range -> aqual -> binder = (fun id t should_bind_var refopt m implicit -> ( @@ -1874,10 +1906,10 @@ end | Some (phi) -> begin if should_bind_pat then begin (match (pat.pat) with -| PatVar (x, _60_413) -> begin +| PatVar (x, _60_419) -> begin (mk_term (Refine ((((mk_binder (Annotated (((x), (t)))) t_range Type None)), (phi)))) range Type) end -| _60_417 -> begin +| _60_423 -> begin ( let x = (FStar_Ident.gen t_range) @@ -1885,18 +1917,18 @@ in ( let phi = ( -let x_var = (let _155_1268 = (let _155_1267 = (FStar_Ident.lid_of_ids ((x)::[])) -in Var (_155_1267)) -in (mk_term _155_1268 phi.range Formula)) +let x_var = (let _155_1296 = (let _155_1295 = (FStar_Ident.lid_of_ids ((x)::[])) +in Var (_155_1295)) +in (mk_term _155_1296 phi.range Formula)) in ( let pat_branch = ((pat), (None), (phi)) in ( -let otherwise_branch = (let _155_1271 = (let _155_1270 = (let _155_1269 = (FStar_Ident.lid_of_path (("False")::[]) phi.range) -in Name (_155_1269)) -in (mk_term _155_1270 phi.range Formula)) -in (((mk_pattern PatWild phi.range)), (None), (_155_1271))) +let otherwise_branch = (let _155_1299 = (let _155_1298 = (let _155_1297 = (FStar_Ident.lid_of_path (("False")::[]) phi.range) +in Name (_155_1297)) +in (mk_term _155_1298 phi.range Formula)) +in (((mk_pattern PatWild phi.range)), (None), (_155_1299))) in (mk_term (Match (((x_var), ((pat_branch)::(otherwise_branch)::[])))) phi.range Formula)))) in (mk_term (Refine ((((mk_binder (Annotated (((x), (t)))) t_range Type None)), (phi)))) range Type))) end) @@ -1911,25 +1943,25 @@ let rec extract_named_refinement : term -> (FStar_Ident.ident * term * term Pr | NamedTyp (x, t) -> begin Some (((x), (t), (None))) end -| Refine ({b = Annotated (x, t); brange = _60_434; blevel = _60_432; aqual = _60_430}, t') -> begin +| Refine ({b = Annotated (x, t); brange = _60_440; blevel = _60_438; aqual = _60_436}, t') -> begin Some (((x), (t), (Some (t')))) end | Paren (t) -> begin (extract_named_refinement t) end -| _60_446 -> begin +| _60_452 -> begin None end)) -let string_of_fsdoc : (Prims.string * (Prims.string * Prims.string) Prims.list) -> Prims.string = (fun _60_449 -> (match (_60_449) with +let string_of_fsdoc : (Prims.string * (Prims.string * Prims.string) Prims.list) -> Prims.string = (fun _60_455 -> (match (_60_455) with | (comment, keywords) -> begin -(let _155_1278 = (let _155_1277 = (FStar_List.map (fun _60_452 -> (match (_60_452) with +(let _155_1306 = (let _155_1305 = (FStar_List.map (fun _60_458 -> (match (_60_458) with | (k, v) -> begin (Prims.strcat k (Prims.strcat "->" v)) end)) keywords) -in (FStar_String.concat "," _155_1277)) -in (Prims.strcat comment _155_1278)) +in (FStar_String.concat "," _155_1305)) +in (Prims.strcat comment _155_1306)) end)) @@ -1945,15 +1977,15 @@ end end)) -let to_string_l = (fun sep f l -> (let _155_1287 = (FStar_List.map f l) -in (FStar_String.concat sep _155_1287))) +let to_string_l = (fun sep f l -> (let _155_1315 = (FStar_List.map f l) +in (FStar_String.concat sep _155_1315))) let imp_to_string : imp -> Prims.string = (fun _60_2 -> (match (_60_2) with | Hash -> begin "#" end -| _60_463 -> begin +| _60_469 -> begin "" end)) @@ -1962,25 +1994,25 @@ let rec term_to_string : term -> Prims.string = (fun x -> (match (x.tm) with | Wild -> begin "_" end -| Requires (t, _60_468) -> begin -(let _155_1295 = (term_to_string t) -in (FStar_Util.format1 "(requires %s)" _155_1295)) +| Requires (t, _60_474) -> begin +(let _155_1323 = (term_to_string t) +in (FStar_Util.format1 "(requires %s)" _155_1323)) end -| Ensures (t, _60_473) -> begin -(let _155_1296 = (term_to_string t) -in (FStar_Util.format1 "(ensures %s)" _155_1296)) +| Ensures (t, _60_479) -> begin +(let _155_1324 = (term_to_string t) +in (FStar_Util.format1 "(ensures %s)" _155_1324)) end -| Labeled (t, l, _60_479) -> begin -(let _155_1297 = (term_to_string t) -in (FStar_Util.format2 "(labeled %s %s)" l _155_1297)) +| Labeled (t, l, _60_485) -> begin +(let _155_1325 = (term_to_string t) +in (FStar_Util.format2 "(labeled %s %s)" l _155_1325)) end | Const (c) -> begin (FStar_Absyn_Print.const_to_string c) end | Op (s, xs) -> begin -(let _155_1300 = (let _155_1299 = (FStar_List.map (fun x -> (FStar_All.pipe_right x term_to_string)) xs) -in (FStar_String.concat ", " _155_1299)) -in (FStar_Util.format2 "%s(%s)" s _155_1300)) +(let _155_1328 = (let _155_1327 = (FStar_List.map (fun x -> (FStar_All.pipe_right x term_to_string)) xs) +in (FStar_String.concat ", " _155_1327)) +in (FStar_Util.format2 "%s(%s)" s _155_1328)) end | Tvar (id) -> begin id.FStar_Ident.idText @@ -1989,93 +2021,93 @@ end l.FStar_Ident.str end | Construct (l, args) -> begin -(let _155_1303 = (to_string_l " " (fun _60_500 -> (match (_60_500) with +(let _155_1331 = (to_string_l " " (fun _60_506 -> (match (_60_506) with | (a, imp) -> begin -(let _155_1302 = (term_to_string a) -in (FStar_Util.format2 "%s%s" (imp_to_string imp) _155_1302)) +(let _155_1330 = (term_to_string a) +in (FStar_Util.format2 "%s%s" (imp_to_string imp) _155_1330)) end)) args) -in (FStar_Util.format2 "(%s %s)" l.FStar_Ident.str _155_1303)) +in (FStar_Util.format2 "(%s %s)" l.FStar_Ident.str _155_1331)) end | Abs (pats, t) -> begin -(let _155_1305 = (to_string_l " " pat_to_string pats) -in (let _155_1304 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "(fun %s -> %s)" _155_1305 _155_1304))) +(let _155_1333 = (to_string_l " " pat_to_string pats) +in (let _155_1332 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "(fun %s -> %s)" _155_1333 _155_1332))) end | App (t1, t2, imp) -> begin -(let _155_1307 = (FStar_All.pipe_right t1 term_to_string) -in (let _155_1306 = (FStar_All.pipe_right t2 term_to_string) -in (FStar_Util.format3 "%s %s%s" _155_1307 (imp_to_string imp) _155_1306))) +(let _155_1335 = (FStar_All.pipe_right t1 term_to_string) +in (let _155_1334 = (FStar_All.pipe_right t2 term_to_string) +in (FStar_Util.format3 "%s %s%s" _155_1335 (imp_to_string imp) _155_1334))) end | Let (Rec, lbs, body) -> begin -(let _155_1312 = (to_string_l " and " (fun _60_517 -> (match (_60_517) with +(let _155_1340 = (to_string_l " and " (fun _60_523 -> (match (_60_523) with | (p, b) -> begin -(let _155_1310 = (FStar_All.pipe_right p pat_to_string) -in (let _155_1309 = (FStar_All.pipe_right b term_to_string) -in (FStar_Util.format2 "%s=%s" _155_1310 _155_1309))) +(let _155_1338 = (FStar_All.pipe_right p pat_to_string) +in (let _155_1337 = (FStar_All.pipe_right b term_to_string) +in (FStar_Util.format2 "%s=%s" _155_1338 _155_1337))) end)) lbs) -in (let _155_1311 = (FStar_All.pipe_right body term_to_string) -in (FStar_Util.format2 "let rec %s in %s" _155_1312 _155_1311))) +in (let _155_1339 = (FStar_All.pipe_right body term_to_string) +in (FStar_Util.format2 "let rec %s in %s" _155_1340 _155_1339))) end | Let (q, ((pat, tm))::[], body) -> begin -(let _155_1315 = (FStar_All.pipe_right pat pat_to_string) -in (let _155_1314 = (FStar_All.pipe_right tm term_to_string) -in (let _155_1313 = (FStar_All.pipe_right body term_to_string) -in (FStar_Util.format4 "let %s %s = %s in %s" (string_of_let_qualifier q) _155_1315 _155_1314 _155_1313)))) +(let _155_1343 = (FStar_All.pipe_right pat pat_to_string) +in (let _155_1342 = (FStar_All.pipe_right tm term_to_string) +in (let _155_1341 = (FStar_All.pipe_right body term_to_string) +in (FStar_Util.format4 "let %s %s = %s in %s" (string_of_let_qualifier q) _155_1343 _155_1342 _155_1341)))) end | Seq (t1, t2) -> begin -(let _155_1317 = (FStar_All.pipe_right t1 term_to_string) -in (let _155_1316 = (FStar_All.pipe_right t2 term_to_string) -in (FStar_Util.format2 "%s; %s" _155_1317 _155_1316))) +(let _155_1345 = (FStar_All.pipe_right t1 term_to_string) +in (let _155_1344 = (FStar_All.pipe_right t2 term_to_string) +in (FStar_Util.format2 "%s; %s" _155_1345 _155_1344))) end | If (t1, t2, t3) -> begin -(let _155_1320 = (FStar_All.pipe_right t1 term_to_string) -in (let _155_1319 = (FStar_All.pipe_right t2 term_to_string) -in (let _155_1318 = (FStar_All.pipe_right t3 term_to_string) -in (FStar_Util.format3 "if %s then %s else %s" _155_1320 _155_1319 _155_1318)))) +(let _155_1348 = (FStar_All.pipe_right t1 term_to_string) +in (let _155_1347 = (FStar_All.pipe_right t2 term_to_string) +in (let _155_1346 = (FStar_All.pipe_right t3 term_to_string) +in (FStar_Util.format3 "if %s then %s else %s" _155_1348 _155_1347 _155_1346)))) end | Match (t, branches) -> begin -(let _155_1327 = (FStar_All.pipe_right t term_to_string) -in (let _155_1326 = (to_string_l " | " (fun _60_542 -> (match (_60_542) with +(let _155_1355 = (FStar_All.pipe_right t term_to_string) +in (let _155_1354 = (to_string_l " | " (fun _60_548 -> (match (_60_548) with | (p, w, e) -> begin -(let _155_1325 = (FStar_All.pipe_right p pat_to_string) -in (let _155_1324 = (match (w) with +(let _155_1353 = (FStar_All.pipe_right p pat_to_string) +in (let _155_1352 = (match (w) with | None -> begin "" end | Some (e) -> begin -(let _155_1322 = (term_to_string e) -in (FStar_Util.format1 "when %s" _155_1322)) +(let _155_1350 = (term_to_string e) +in (FStar_Util.format1 "when %s" _155_1350)) end) -in (let _155_1323 = (FStar_All.pipe_right e term_to_string) -in (FStar_Util.format3 "%s %s -> %s" _155_1325 _155_1324 _155_1323)))) +in (let _155_1351 = (FStar_All.pipe_right e term_to_string) +in (FStar_Util.format3 "%s %s -> %s" _155_1353 _155_1352 _155_1351)))) end)) branches) -in (FStar_Util.format2 "match %s with %s" _155_1327 _155_1326))) +in (FStar_Util.format2 "match %s with %s" _155_1355 _155_1354))) end | Ascribed (t1, t2) -> begin -(let _155_1329 = (FStar_All.pipe_right t1 term_to_string) -in (let _155_1328 = (FStar_All.pipe_right t2 term_to_string) -in (FStar_Util.format2 "(%s : %s)" _155_1329 _155_1328))) +(let _155_1357 = (FStar_All.pipe_right t1 term_to_string) +in (let _155_1356 = (FStar_All.pipe_right t2 term_to_string) +in (FStar_Util.format2 "(%s : %s)" _155_1357 _155_1356))) end | Record (Some (e), fields) -> begin -(let _155_1333 = (FStar_All.pipe_right e term_to_string) -in (let _155_1332 = (to_string_l " " (fun _60_557 -> (match (_60_557) with +(let _155_1361 = (FStar_All.pipe_right e term_to_string) +in (let _155_1360 = (to_string_l " " (fun _60_563 -> (match (_60_563) with | (l, e) -> begin -(let _155_1331 = (FStar_All.pipe_right e term_to_string) -in (FStar_Util.format2 "%s=%s" l.FStar_Ident.str _155_1331)) +(let _155_1359 = (FStar_All.pipe_right e term_to_string) +in (FStar_Util.format2 "%s=%s" l.FStar_Ident.str _155_1359)) end)) fields) -in (FStar_Util.format2 "{%s with %s}" _155_1333 _155_1332))) +in (FStar_Util.format2 "{%s with %s}" _155_1361 _155_1360))) end | Record (None, fields) -> begin -(let _155_1336 = (to_string_l " " (fun _60_564 -> (match (_60_564) with +(let _155_1364 = (to_string_l " " (fun _60_570 -> (match (_60_570) with | (l, e) -> begin -(let _155_1335 = (FStar_All.pipe_right e term_to_string) -in (FStar_Util.format2 "%s=%s" l.FStar_Ident.str _155_1335)) +(let _155_1363 = (FStar_All.pipe_right e term_to_string) +in (FStar_Util.format2 "%s=%s" l.FStar_Ident.str _155_1363)) end)) fields) -in (FStar_Util.format1 "{%s}" _155_1336)) +in (FStar_Util.format1 "{%s}" _155_1364)) end | Project (e, l) -> begin -(let _155_1337 = (FStar_All.pipe_right e term_to_string) -in (FStar_Util.format2 "%s.%s" _155_1337 l.FStar_Ident.str)) +(let _155_1365 = (FStar_All.pipe_right e term_to_string) +in (FStar_Util.format2 "%s.%s" _155_1365 l.FStar_Ident.str)) end | Product ([], t) -> begin (term_to_string t) @@ -2084,51 +2116,51 @@ end (term_to_string (mk_term (Product ((((b)::[]), ((mk_term (Product ((((hd)::tl), (t)))) x.range x.level))))) x.range x.level)) end | Product ((b)::[], t) when (x.level = Type) -> begin -(let _155_1339 = (FStar_All.pipe_right b binder_to_string) -in (let _155_1338 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s -> %s" _155_1339 _155_1338))) +(let _155_1367 = (FStar_All.pipe_right b binder_to_string) +in (let _155_1366 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s -> %s" _155_1367 _155_1366))) end | Product ((b)::[], t) when (x.level = Kind) -> begin -(let _155_1341 = (FStar_All.pipe_right b binder_to_string) -in (let _155_1340 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s => %s" _155_1341 _155_1340))) +(let _155_1369 = (FStar_All.pipe_right b binder_to_string) +in (let _155_1368 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s => %s" _155_1369 _155_1368))) end | Sum (binders, t) -> begin -(let _155_1344 = (let _155_1342 = (FStar_All.pipe_right binders (FStar_List.map binder_to_string)) -in (FStar_All.pipe_right _155_1342 (FStar_String.concat " * "))) -in (let _155_1343 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s * %s" _155_1344 _155_1343))) +(let _155_1372 = (let _155_1370 = (FStar_All.pipe_right binders (FStar_List.map binder_to_string)) +in (FStar_All.pipe_right _155_1370 (FStar_String.concat " * "))) +in (let _155_1371 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s * %s" _155_1372 _155_1371))) end | QForall (bs, pats, t) -> begin -(let _155_1347 = (to_string_l " " binder_to_string bs) -in (let _155_1346 = (to_string_l " \\/ " (to_string_l "; " term_to_string) pats) -in (let _155_1345 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format3 "forall %s.{:pattern %s} %s" _155_1347 _155_1346 _155_1345)))) +(let _155_1375 = (to_string_l " " binder_to_string bs) +in (let _155_1374 = (to_string_l " \\/ " (to_string_l "; " term_to_string) pats) +in (let _155_1373 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format3 "forall %s.{:pattern %s} %s" _155_1375 _155_1374 _155_1373)))) end | QExists (bs, pats, t) -> begin -(let _155_1350 = (to_string_l " " binder_to_string bs) -in (let _155_1349 = (to_string_l " \\/ " (to_string_l "; " term_to_string) pats) -in (let _155_1348 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format3 "exists %s.{:pattern %s} %s" _155_1350 _155_1349 _155_1348)))) +(let _155_1378 = (to_string_l " " binder_to_string bs) +in (let _155_1377 = (to_string_l " \\/ " (to_string_l "; " term_to_string) pats) +in (let _155_1376 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format3 "exists %s.{:pattern %s} %s" _155_1378 _155_1377 _155_1376)))) end | Refine (b, t) -> begin -(let _155_1352 = (FStar_All.pipe_right b binder_to_string) -in (let _155_1351 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s:{%s}" _155_1352 _155_1351))) +(let _155_1380 = (FStar_All.pipe_right b binder_to_string) +in (let _155_1379 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s:{%s}" _155_1380 _155_1379))) end | NamedTyp (x, t) -> begin -(let _155_1353 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s:%s" x.FStar_Ident.idText _155_1353)) +(let _155_1381 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s:%s" x.FStar_Ident.idText _155_1381)) end | Paren (t) -> begin -(let _155_1354 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format1 "(%s)" _155_1354)) +(let _155_1382 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format1 "(%s)" _155_1382)) end | Product (bs, t) -> begin -(let _155_1357 = (let _155_1355 = (FStar_All.pipe_right bs (FStar_List.map binder_to_string)) -in (FStar_All.pipe_right _155_1355 (FStar_String.concat ","))) -in (let _155_1356 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "Unidentified product: [%s] %s" _155_1357 _155_1356))) +(let _155_1385 = (let _155_1383 = (FStar_All.pipe_right bs (FStar_List.map binder_to_string)) +in (FStar_All.pipe_right _155_1383 (FStar_String.concat ","))) +in (let _155_1384 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "Unidentified product: [%s] %s" _155_1385 _155_1384))) end | t -> begin "_" @@ -2143,14 +2175,14 @@ end (FStar_Util.format1 "%s:_" i.FStar_Ident.idText) end | (TAnnotated (i, t)) | (Annotated (i, t)) -> begin -(let _155_1359 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "%s:%s" i.FStar_Ident.idText _155_1359)) +(let _155_1387 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "%s:%s" i.FStar_Ident.idText _155_1387)) end | NoName (t) -> begin (FStar_All.pipe_right t term_to_string) end) -in (let _155_1360 = (aqual_to_string x.aqual) -in (FStar_Util.format2 "%s%s" _155_1360 s)))) +in (let _155_1388 = (aqual_to_string x.aqual) +in (FStar_Util.format2 "%s%s" _155_1388 s)))) and aqual_to_string : aqual -> Prims.string = (fun _60_3 -> (match (_60_3) with | Some (Equality) -> begin "$" @@ -2158,7 +2190,7 @@ end | Some (Implicit) -> begin "#" end -| _60_640 -> begin +| _60_646 -> begin "" end)) and pat_to_string : pattern -> Prims.string = (fun x -> (match (x.pat) with @@ -2169,36 +2201,36 @@ end (FStar_Absyn_Print.const_to_string c) end | PatApp (p, ps) -> begin -(let _155_1364 = (FStar_All.pipe_right p pat_to_string) -in (let _155_1363 = (to_string_l " " pat_to_string ps) -in (FStar_Util.format2 "(%s %s)" _155_1364 _155_1363))) +(let _155_1392 = (FStar_All.pipe_right p pat_to_string) +in (let _155_1391 = (to_string_l " " pat_to_string ps) +in (FStar_Util.format2 "(%s %s)" _155_1392 _155_1391))) end | (PatTvar (i, aq)) | (PatVar (i, aq)) -> begin -(let _155_1365 = (aqual_to_string aq) -in (FStar_Util.format2 "%s%s" _155_1365 i.FStar_Ident.idText)) +(let _155_1393 = (aqual_to_string aq) +in (FStar_Util.format2 "%s%s" _155_1393 i.FStar_Ident.idText)) end | PatName (l) -> begin l.FStar_Ident.str end | PatList (l) -> begin -(let _155_1366 = (to_string_l "; " pat_to_string l) -in (FStar_Util.format1 "[%s]" _155_1366)) +(let _155_1394 = (to_string_l "; " pat_to_string l) +in (FStar_Util.format1 "[%s]" _155_1394)) end | PatTuple (l, false) -> begin -(let _155_1367 = (to_string_l ", " pat_to_string l) -in (FStar_Util.format1 "(%s)" _155_1367)) +(let _155_1395 = (to_string_l ", " pat_to_string l) +in (FStar_Util.format1 "(%s)" _155_1395)) end | PatTuple (l, true) -> begin -(let _155_1368 = (to_string_l ", " pat_to_string l) -in (FStar_Util.format1 "(|%s|)" _155_1368)) +(let _155_1396 = (to_string_l ", " pat_to_string l) +in (FStar_Util.format1 "(|%s|)" _155_1396)) end | PatRecord (l) -> begin -(let _155_1371 = (to_string_l "; " (fun _60_671 -> (match (_60_671) with +(let _155_1399 = (to_string_l "; " (fun _60_677 -> (match (_60_677) with | (f, e) -> begin -(let _155_1370 = (FStar_All.pipe_right e pat_to_string) -in (FStar_Util.format2 "%s=%s" f.FStar_Ident.str _155_1370)) +(let _155_1398 = (FStar_All.pipe_right e pat_to_string) +in (FStar_Util.format2 "%s=%s" f.FStar_Ident.str _155_1398)) end)) l) -in (FStar_Util.format1 "{%s}" _155_1371)) +in (FStar_Util.format1 "{%s}" _155_1399)) end | PatOr (l) -> begin (to_string_l "|\n " pat_to_string l) @@ -2207,9 +2239,9 @@ end (FStar_Util.format1 "(%s)" op) end | PatAscribed (p, t) -> begin -(let _155_1373 = (FStar_All.pipe_right p pat_to_string) -in (let _155_1372 = (FStar_All.pipe_right t term_to_string) -in (FStar_Util.format2 "(%s:%s)" _155_1373 _155_1372))) +(let _155_1401 = (FStar_All.pipe_right p pat_to_string) +in (let _155_1400 = (FStar_All.pipe_right t term_to_string) +in (FStar_Util.format2 "(%s:%s)" _155_1401 _155_1400))) end)) @@ -2217,23 +2249,23 @@ let rec head_id_of_pat : pattern -> FStar_Ident.lid Prims.list = (fun p -> (ma | PatName (l) -> begin (l)::[] end -| PatVar (i, _60_685) -> begin -(let _155_1376 = (FStar_Ident.lid_of_ids ((i)::[])) -in (_155_1376)::[]) +| PatVar (i, _60_691) -> begin +(let _155_1404 = (FStar_Ident.lid_of_ids ((i)::[])) +in (_155_1404)::[]) end -| PatApp (p, _60_690) -> begin +| PatApp (p, _60_696) -> begin (head_id_of_pat p) end -| PatAscribed (p, _60_695) -> begin +| PatAscribed (p, _60_701) -> begin (head_id_of_pat p) end -| _60_699 -> begin +| _60_705 -> begin [] end)) -let lids_of_let = (fun defs -> (FStar_All.pipe_right defs (FStar_List.collect (fun _60_704 -> (match (_60_704) with -| (p, _60_703) -> begin +let lids_of_let = (fun defs -> (FStar_All.pipe_right defs (FStar_List.collect (fun _60_710 -> (match (_60_710) with +| (p, _60_709) -> begin (head_id_of_pat p) end))))) @@ -2254,33 +2286,33 @@ end | ModuleAbbrev (i, l) -> begin (FStar_Util.format2 "module %s = %s" i.FStar_Ident.idText l.FStar_Ident.str) end -| KindAbbrev (i, _60_748, _60_750) -> begin +| KindAbbrev (i, _60_754, _60_756) -> begin (Prims.strcat "kind " i.FStar_Ident.idText) end -| TopLevelLet (_60_754, _60_756, pats) -> begin -(let _155_1386 = (let _155_1385 = (let _155_1384 = (lids_of_let pats) -in (FStar_All.pipe_right _155_1384 (FStar_List.map (fun l -> l.FStar_Ident.str)))) -in (FStar_All.pipe_right _155_1385 (FStar_String.concat ", "))) -in (Prims.strcat "let " _155_1386)) +| TopLevelLet (_60_760, _60_762, pats) -> begin +(let _155_1414 = (let _155_1413 = (let _155_1412 = (lids_of_let pats) +in (FStar_All.pipe_right _155_1412 (FStar_List.map (fun l -> l.FStar_Ident.str)))) +in (FStar_All.pipe_right _155_1413 (FStar_String.concat ", "))) +in (Prims.strcat "let " _155_1414)) end -| Main (_60_762) -> begin +| Main (_60_768) -> begin "main ..." end -| Assume (_60_765, i, _60_768) -> begin +| Assume (_60_771, i, _60_774) -> begin (Prims.strcat "assume " i.FStar_Ident.idText) end -| Tycon (_60_772, tys) -> begin -(let _155_1389 = (let _155_1388 = (FStar_All.pipe_right tys (FStar_List.map (fun _60_779 -> (match (_60_779) with -| (x, _60_778) -> begin +| Tycon (_60_778, tys) -> begin +(let _155_1417 = (let _155_1416 = (FStar_All.pipe_right tys (FStar_List.map (fun _60_785 -> (match (_60_785) with +| (x, _60_784) -> begin (id_of_tycon x) end)))) -in (FStar_All.pipe_right _155_1388 (FStar_String.concat ", "))) -in (Prims.strcat "type " _155_1389)) +in (FStar_All.pipe_right _155_1416 (FStar_String.concat ", "))) +in (Prims.strcat "type " _155_1417)) end -| Val (_60_781, i, _60_784) -> begin +| Val (_60_787, i, _60_790) -> begin (Prims.strcat "val " i.FStar_Ident.idText) end -| Exception (i, _60_789) -> begin +| Exception (i, _60_795) -> begin (Prims.strcat "exception " i.FStar_Ident.idText) end | (NewEffect (_, DefineEffect (i, _, _, _, _))) | (NewEffect (_, RedefineEffect (i, _, _))) -> begin @@ -2289,21 +2321,21 @@ end | (NewEffectForFree (_, DefineEffect (i, _, _, _, _))) | (NewEffectForFree (_, RedefineEffect (i, _, _))) -> begin (Prims.strcat "new_effect_for_free " i.FStar_Ident.idText) end -| SubEffect (_60_843) -> begin +| SubEffect (_60_849) -> begin "sub_effect" end -| Pragma (_60_846) -> begin +| Pragma (_60_852) -> begin "pragma" end -| Fsdoc (_60_849) -> begin +| Fsdoc (_60_855) -> begin "fsdoc" end)) let modul_to_string : modul -> Prims.string = (fun m -> (match (m) with | (Module (_, decls)) | (Interface (_, decls, _)) -> begin -(let _155_1392 = (FStar_All.pipe_right decls (FStar_List.map decl_to_string)) -in (FStar_All.pipe_right _155_1392 (FStar_String.concat "\n"))) +(let _155_1420 = (FStar_All.pipe_right decls (FStar_List.map decl_to_string)) +in (FStar_All.pipe_right _155_1420 (FStar_String.concat "\n"))) end)) @@ -2313,8 +2345,8 @@ let tm = (FStar_All.pipe_right tm term_to_string) in ( let tm = if ((FStar_String.length tm) >= (Prims.parse_int "80")) then begin -(let _155_1396 = (FStar_Util.substring tm (Prims.parse_int "0") (Prims.parse_int "77")) -in (Prims.strcat _155_1396 "...")) +(let _155_1424 = (FStar_Util.substring tm (Prims.parse_int "0") (Prims.parse_int "77")) +in (Prims.strcat _155_1424 "...")) end else begin tm end diff --git a/src/ocaml-output/FStar_Parser_Dep.ml b/src/ocaml-output/FStar_Parser_Dep.ml index 0bad830e472..6d8a64143f2 100755 --- a/src/ocaml-output/FStar_Parser_Dep.ml +++ b/src/ocaml-output/FStar_Parser_Dep.ml @@ -293,7 +293,7 @@ in ( let record_open = (fun let_open lid -> ( let key = (lowercase_join_longident lid true) -in (match ((FStar_Util.smap_try_find original_map key)) with +in (match ((FStar_Util.smap_try_find working_map key)) with | Some (pair) -> begin (FStar_List.iter (fun f -> (let _165_100 = (lowercase_module_name f) in (add_dep _165_100))) (list_of_pair pair)) @@ -623,42 +623,42 @@ end | FStar_Parser_AST.Tvar (_70_447) -> begin () end -| (FStar_Parser_AST.Var (lid)) | (FStar_Parser_AST.Name (lid)) -> begin +| (FStar_Parser_AST.Var (lid)) | (FStar_Parser_AST.Projector (lid, _)) | (FStar_Parser_AST.Discrim (lid)) | (FStar_Parser_AST.Name (lid)) -> begin (record_lid false lid) end | FStar_Parser_AST.Construct (lid, termimps) -> begin ( -let _70_456 = if (((FStar_List.length termimps) = (Prims.parse_int "1")) && (FStar_Options.universes ())) then begin +let _70_461 = if (((FStar_List.length termimps) = (Prims.parse_int "1")) && (FStar_Options.universes ())) then begin (record_lid true lid) end else begin () end -in (FStar_List.iter (fun _70_461 -> (match (_70_461) with -| (t, _70_460) -> begin +in (FStar_List.iter (fun _70_466 -> (match (_70_466) with +| (t, _70_465) -> begin (collect_term t) end)) termimps)) end | FStar_Parser_AST.Abs (pats, t) -> begin ( -let _70_466 = (collect_patterns pats) +let _70_471 = (collect_patterns pats) in (collect_term t)) end -| FStar_Parser_AST.App (t1, t2, _70_471) -> begin +| FStar_Parser_AST.App (t1, t2, _70_476) -> begin ( -let _70_474 = (collect_term t1) +let _70_479 = (collect_term t1) in (collect_term t2)) end -| FStar_Parser_AST.Let (_70_477, patterms, t) -> begin +| FStar_Parser_AST.Let (_70_482, patterms, t) -> begin ( -let _70_487 = (FStar_List.iter (fun _70_484 -> (match (_70_484) with +let _70_492 = (FStar_List.iter (fun _70_489 -> (match (_70_489) with | (pat, t) -> begin ( -let _70_485 = (collect_pattern pat) +let _70_490 = (collect_pattern pat) in (collect_term t)) end)) patterms) in (collect_term t)) @@ -666,70 +666,70 @@ end | FStar_Parser_AST.LetOpen (lid, t) -> begin ( -let _70_493 = (record_open true lid) +let _70_498 = (record_open true lid) in (collect_term t)) end | FStar_Parser_AST.Seq (t1, t2) -> begin ( -let _70_499 = (collect_term t1) +let _70_504 = (collect_term t1) in (collect_term t2)) end | FStar_Parser_AST.If (t1, t2, t3) -> begin ( -let _70_506 = (collect_term t1) +let _70_511 = (collect_term t1) in ( -let _70_508 = (collect_term t2) +let _70_513 = (collect_term t2) in (collect_term t3))) end | (FStar_Parser_AST.Match (t, bs)) | (FStar_Parser_AST.TryWith (t, bs)) -> begin ( -let _70_516 = (collect_term t) +let _70_521 = (collect_term t) in (collect_branches bs)) end | FStar_Parser_AST.Ascribed (t1, t2) -> begin ( -let _70_522 = (collect_term t1) +let _70_527 = (collect_term t1) in (collect_term t2)) end | FStar_Parser_AST.Record (t, idterms) -> begin ( -let _70_528 = (FStar_Util.iter_opt t collect_term) -in (FStar_List.iter (fun _70_533 -> (match (_70_533) with -| (_70_531, t) -> begin +let _70_533 = (FStar_Util.iter_opt t collect_term) +in (FStar_List.iter (fun _70_538 -> (match (_70_538) with +| (_70_536, t) -> begin (collect_term t) end)) idterms)) end -| FStar_Parser_AST.Project (t, _70_536) -> begin +| FStar_Parser_AST.Project (t, _70_541) -> begin (collect_term t) end | (FStar_Parser_AST.Product (binders, t)) | (FStar_Parser_AST.Sum (binders, t)) -> begin ( -let _70_545 = (collect_binders binders) +let _70_550 = (collect_binders binders) in (collect_term t)) end | (FStar_Parser_AST.QForall (binders, ts, t)) | (FStar_Parser_AST.QExists (binders, ts, t)) -> begin ( -let _70_554 = (collect_binders binders) +let _70_559 = (collect_binders binders) in ( -let _70_556 = (FStar_List.iter (FStar_List.iter collect_term) ts) +let _70_561 = (FStar_List.iter (FStar_List.iter collect_term) ts) in (collect_term t))) end | FStar_Parser_AST.Refine (binder, t) -> begin ( -let _70_562 = (collect_binder binder) +let _70_567 = (collect_binder binder) in (collect_term t)) end -| FStar_Parser_AST.NamedTyp (_70_565, t) -> begin +| FStar_Parser_AST.NamedTyp (_70_570, t) -> begin (collect_term t) end | FStar_Parser_AST.Paren (t) -> begin @@ -747,7 +747,7 @@ end | FStar_Parser_AST.PatApp (p, ps) -> begin ( -let _70_604 = (collect_pattern p) +let _70_609 = (collect_pattern p) in (collect_patterns ps)) end | (FStar_Parser_AST.PatVar (_)) | (FStar_Parser_AST.PatName (_)) | (FStar_Parser_AST.PatTvar (_)) -> begin @@ -757,26 +757,26 @@ end (collect_patterns ps) end | FStar_Parser_AST.PatRecord (lidpats) -> begin -(FStar_List.iter (fun _70_627 -> (match (_70_627) with -| (_70_625, p) -> begin +(FStar_List.iter (fun _70_632 -> (match (_70_632) with +| (_70_630, p) -> begin (collect_pattern p) end)) lidpats) end | FStar_Parser_AST.PatAscribed (p, t) -> begin ( -let _70_632 = (collect_pattern p) +let _70_637 = (collect_pattern p) in (collect_term t)) end)) and collect_branches = (fun bs -> (FStar_List.iter collect_branch bs)) -and collect_branch = (fun _70_638 -> (match (_70_638) with +and collect_branch = (fun _70_643 -> (match (_70_643) with | (pat, t1, t2) -> begin ( -let _70_639 = (collect_pattern pat) +let _70_644 = (collect_pattern pat) in ( -let _70_641 = (FStar_Util.iter_opt t1 collect_term) +let _70_646 = (FStar_Util.iter_opt t1 collect_term) in (collect_term t2))) end)) in ( @@ -784,7 +784,7 @@ in ( let ast = (FStar_Parser_Driver.parse_file filename) in ( -let _70_644 = (collect_file ast) +let _70_649 = (collect_file ast) in (FStar_ST.read deps)))))))))))))) @@ -823,13 +823,13 @@ end)) let print_graph = (fun graph -> ( -let _70_647 = (FStar_Util.print_endline "A DOT-format graph has been dumped in the current directory as dep.graph") +let _70_652 = (FStar_Util.print_endline "A DOT-format graph has been dumped in the current directory as dep.graph") in ( -let _70_649 = (FStar_Util.print_endline "With GraphViz installed, try: fdp -Tpng -odep.png dep.graph") +let _70_654 = (FStar_Util.print_endline "With GraphViz installed, try: fdp -Tpng -odep.png dep.graph") in ( -let _70_651 = (FStar_Util.print_endline "Hint: cat dep.graph | grep -v _ | grep -v prims") +let _70_656 = (FStar_Util.print_endline "Hint: cat dep.graph | grep -v _ | grep -v prims") in (let _165_192 = (let _165_191 = (let _165_190 = (let _165_189 = (let _165_188 = (let _165_187 = (FStar_Util.smap_keys graph) in (FStar_List.unique _165_187)) in (FStar_List.collect (fun k -> ( @@ -866,9 +866,9 @@ in ( let rec discover_one = (fun is_user_provided_filename key -> if ((FStar_Util.smap_try_find graph key) = None) then begin ( -let _70_670 = (let _165_207 = (FStar_Util.smap_try_find m key) +let _70_675 = (let _165_207 = (FStar_Util.smap_try_find m key) in (FStar_Util.must _165_207)) -in (match (_70_670) with +in (match (_70_675) with | (intf, impl) -> begin ( @@ -893,7 +893,7 @@ in ( let deps = (FStar_List.unique (FStar_List.append impl_deps intf_deps)) in ( -let _70_680 = (FStar_Util.smap_add graph key ((deps), (White))) +let _70_685 = (FStar_Util.smap_add graph key ((deps), (White))) in (FStar_List.iter (discover_one false) deps))))) end)) end else begin @@ -901,7 +901,7 @@ end else begin end) in ( -let _70_682 = (let _165_208 = (FStar_List.map lowercase_module_name filenames) +let _70_687 = (let _165_208 = (FStar_List.map lowercase_module_name filenames) in (FStar_List.iter (discover_one true) _165_208)) in ( @@ -913,24 +913,24 @@ in ( let rec discover = (fun cycle key -> ( -let _70_691 = (let _165_213 = (FStar_Util.smap_try_find graph key) +let _70_696 = (let _165_213 = (FStar_Util.smap_try_find graph key) in (FStar_Util.must _165_213)) -in (match (_70_691) with +in (match (_70_696) with | (direct_deps, color) -> begin (match (color) with | Gray -> begin ( -let _70_693 = (FStar_Util.print1 "Warning: recursive dependency on module %s\n" key) +let _70_698 = (FStar_Util.print1 "Warning: recursive dependency on module %s\n" key) in ( -let _70_695 = (FStar_Util.print1 "The cycle is: %s \n" (FStar_String.concat " -> " cycle)) +let _70_700 = (FStar_Util.print1 "The cycle is: %s \n" (FStar_String.concat " -> " cycle)) in ( -let _70_697 = (print_graph immediate_graph) +let _70_702 = (print_graph immediate_graph) in ( -let _70_699 = (FStar_Util.print_string "\n") +let _70_704 = (FStar_Util.print_string "\n") in (FStar_All.exit (Prims.parse_int "1")))))) end | Black -> begin @@ -939,7 +939,7 @@ end | White -> begin ( -let _70_703 = (FStar_Util.smap_add graph key ((direct_deps), (Gray))) +let _70_708 = (FStar_Util.smap_add graph key ((direct_deps), (Gray))) in ( let all_deps = (let _165_217 = (let _165_216 = (FStar_List.map (fun dep -> (let _165_215 = (discover ((key)::cycle) dep) @@ -948,10 +948,10 @@ in (FStar_List.flatten _165_216)) in (FStar_List.unique _165_217)) in ( -let _70_707 = (FStar_Util.smap_add graph key ((all_deps), (Black))) +let _70_712 = (FStar_Util.smap_add graph key ((all_deps), (Black))) in ( -let _70_709 = (let _165_219 = (let _165_218 = (FStar_ST.read topologically_sorted) +let _70_714 = (let _165_219 = (let _165_218 = (FStar_ST.read topologically_sorted) in (key)::_165_218) in (FStar_ST.op_Colon_Equals topologically_sorted _165_219)) in all_deps)))) @@ -1004,7 +1004,7 @@ let topologically_sorted = (let _165_230 = (FStar_ST.read topologically_sorted) in (FStar_List.collect must_find_r _165_230)) in ( -let _70_729 = (FStar_List.iter (fun _70_728 -> (match (_70_728) with +let _70_734 = (FStar_List.iter (fun _70_733 -> (match (_70_733) with | (m, r) -> begin if ((not ((FStar_ST.read r))) && (not ((FStar_Options.interactive ())))) then begin (let _165_233 = (let _165_232 = (FStar_Util.format2 "You passed --verify_module %s but I found no file that contains [module %s] in the dependency graph\n" m m) @@ -1017,7 +1017,7 @@ end)) verify_flags) in ((by_target), (topologically_sorted), (immediate_graph)))))))))))))))))) -let print_make : (Prims.string * Prims.string Prims.list) Prims.list -> Prims.unit = (fun deps -> (FStar_List.iter (fun _70_734 -> (match (_70_734) with +let print_make : (Prims.string * Prims.string Prims.list) Prims.list -> Prims.unit = (fun deps -> (FStar_List.iter (fun _70_739 -> (match (_70_739) with | (f, deps) -> begin ( @@ -1026,8 +1026,8 @@ in (FStar_Util.print2 "%s: %s\n" f (FStar_String.concat " " deps))) end)) deps)) -let print = (fun _70_741 -> (match (_70_741) with -| (make_deps, _70_739, graph) -> begin +let print = (fun _70_746 -> (match (_70_746) with +| (make_deps, _70_744, graph) -> begin (match ((FStar_Options.dep ())) with | Some ("make") -> begin (print_make make_deps) @@ -1035,7 +1035,7 @@ end | Some ("graph") -> begin (print_graph graph) end -| Some (_70_747) -> begin +| Some (_70_752) -> begin (Prims.raise (FStar_Absyn_Syntax.Err ("unknown tool for --dep\n"))) end | None -> begin diff --git a/src/ocaml-output/FStar_Parser_Desugar.ml b/src/ocaml-output/FStar_Parser_Desugar.ml index a885396fc2d..4b9491faf03 100755 --- a/src/ocaml-output/FStar_Parser_Desugar.ml +++ b/src/ocaml-output/FStar_Parser_Desugar.ml @@ -467,22 +467,22 @@ end [] end) end -| (FStar_Parser_AST.Wild) | (FStar_Parser_AST.Const (_)) | (FStar_Parser_AST.Var (_)) | (FStar_Parser_AST.Name (_)) -> begin +| (FStar_Parser_AST.Wild) | (FStar_Parser_AST.Const (_)) | (FStar_Parser_AST.Var (_)) | (FStar_Parser_AST.Projector (_)) | (FStar_Parser_AST.Discrim (_)) | (FStar_Parser_AST.Name (_)) -> begin [] end | (FStar_Parser_AST.Requires (t, _)) | (FStar_Parser_AST.Ensures (t, _)) | (FStar_Parser_AST.Labeled (t, _, _)) | (FStar_Parser_AST.NamedTyp (_, t)) | (FStar_Parser_AST.Paren (t)) | (FStar_Parser_AST.Ascribed (t, _)) -> begin (free_type_vars env t) end -| FStar_Parser_AST.Construct (_62_533, ts) -> begin -(FStar_List.collect (fun _62_540 -> (match (_62_540) with -| (t, _62_539) -> begin +| FStar_Parser_AST.Construct (_62_539, ts) -> begin +(FStar_List.collect (fun _62_546 -> (match (_62_546) with +| (t, _62_545) -> begin (free_type_vars env t) end)) ts) end -| FStar_Parser_AST.Op (_62_542, ts) -> begin +| FStar_Parser_AST.Op (_62_548, ts) -> begin (FStar_List.collect (free_type_vars env) ts) end -| FStar_Parser_AST.App (t1, t2, _62_549) -> begin +| FStar_Parser_AST.App (t1, t2, _62_555) -> begin (let _157_104 = (free_type_vars env t1) in (let _157_103 = (free_type_vars env t2) in (FStar_List.append _157_104 _157_103))) @@ -490,8 +490,8 @@ end | FStar_Parser_AST.Refine (b, t) -> begin ( -let _62_558 = (free_type_vars_b env b) -in (match (_62_558) with +let _62_564 = (free_type_vars_b env b) +in (match (_62_564) with | (env, f) -> begin (let _157_105 = (free_type_vars env t) in (FStar_List.append f _157_105)) @@ -500,23 +500,23 @@ end | (FStar_Parser_AST.Product (binders, body)) | (FStar_Parser_AST.Sum (binders, body)) -> begin ( -let _62_574 = (FStar_List.fold_left (fun _62_567 binder -> (match (_62_567) with +let _62_580 = (FStar_List.fold_left (fun _62_573 binder -> (match (_62_573) with | (env, free) -> begin ( -let _62_571 = (free_type_vars_b env binder) -in (match (_62_571) with +let _62_577 = (free_type_vars_b env binder) +in (match (_62_577) with | (env, f) -> begin ((env), ((FStar_List.append f free))) end)) end)) ((env), ([])) binders) -in (match (_62_574) with +in (match (_62_580) with | (env, free) -> begin (let _157_108 = (free_type_vars env body) in (FStar_List.append free _157_108)) end)) end -| FStar_Parser_AST.Project (t, _62_577) -> begin +| FStar_Parser_AST.Project (t, _62_583) -> begin (free_type_vars env t) end | (FStar_Parser_AST.Abs (_)) | (FStar_Parser_AST.Let (_)) | (FStar_Parser_AST.LetOpen (_)) | (FStar_Parser_AST.If (_)) | (FStar_Parser_AST.QForall (_)) | (FStar_Parser_AST.QExists (_)) -> begin @@ -537,7 +537,7 @@ end | FStar_Parser_AST.Construct (l, args') -> begin (({FStar_Parser_AST.tm = FStar_Parser_AST.Name (l); FStar_Parser_AST.range = t.FStar_Parser_AST.range; FStar_Parser_AST.level = t.FStar_Parser_AST.level}), ((FStar_List.append args' args))) end -| _62_627 -> begin +| _62_633 -> begin ((t), (args)) end)) in (aux [] t))) @@ -580,10 +580,10 @@ in ( let t = (match ((let _157_134 = (unlabel t) in _157_134.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.Product (_62_640) -> begin +| FStar_Parser_AST.Product (_62_646) -> begin t end -| _62_643 -> begin +| _62_649 -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.App ((((FStar_Parser_AST.mk_term (FStar_Parser_AST.Name (FStar_Absyn_Const.effect_Tot_lid)) t.FStar_Parser_AST.range t.FStar_Parser_AST.level)), (t), (FStar_Parser_AST.Nothing)))) t.FStar_Parser_AST.range t.FStar_Parser_AST.level) end) in ( @@ -597,19 +597,19 @@ let rec uncurry : FStar_Parser_AST.binder Prims.list -> FStar_Parser_AST.term | FStar_Parser_AST.Product (binders, t) -> begin (uncurry (FStar_List.append bs binders) t) end -| _62_653 -> begin +| _62_659 -> begin ((bs), (t)) end)) let rec is_app_pattern : FStar_Parser_AST.pattern -> Prims.bool = (fun p -> (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed (p, _62_657) -> begin +| FStar_Parser_AST.PatAscribed (p, _62_663) -> begin (is_app_pattern p) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (_62_663); FStar_Parser_AST.prange = _62_661}, _62_667) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (_62_669); FStar_Parser_AST.prange = _62_667}, _62_673) -> begin true end -| _62_671 -> begin +| _62_677 -> begin false end)) @@ -618,21 +618,21 @@ let rec destruct_app_pattern : FStar_Parser_DesugarEnv.env -> Prims.bool -> | FStar_Parser_AST.PatAscribed (p, t) -> begin ( -let _62_683 = (destruct_app_pattern env is_top_level p) -in (match (_62_683) with -| (name, args, _62_682) -> begin +let _62_689 = (destruct_app_pattern env is_top_level p) +in (match (_62_689) with +| (name, args, _62_688) -> begin ((name), (args), (Some (t))) end)) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_688); FStar_Parser_AST.prange = _62_685}, args) when is_top_level -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_694); FStar_Parser_AST.prange = _62_691}, args) when is_top_level -> begin (let _157_148 = (let _157_147 = (FStar_Parser_DesugarEnv.qualify env id) in FStar_Util.Inr (_157_147)) in ((_157_148), (args), (None))) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_699); FStar_Parser_AST.prange = _62_696}, args) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_705); FStar_Parser_AST.prange = _62_702}, args) -> begin ((FStar_Util.Inl (id)), (args), (None)) end -| _62_707 -> begin +| _62_713 -> begin (FStar_All.failwith "Not an app pattern") end)) @@ -671,20 +671,20 @@ end)) let ___TBinder____0 = (fun projectee -> (match (projectee) with -| TBinder (_62_710) -> begin -_62_710 +| TBinder (_62_716) -> begin +_62_716 end)) let ___VBinder____0 = (fun projectee -> (match (projectee) with -| VBinder (_62_713) -> begin -_62_713 +| VBinder (_62_719) -> begin +_62_719 end)) let ___LetBinder____0 = (fun projectee -> (match (projectee) with -| LetBinder (_62_716) -> begin -_62_716 +| LetBinder (_62_722) -> begin +_62_722 end)) @@ -695,7 +695,7 @@ end | VBinder (x, t, aq) -> begin ((FStar_Util.Inr ((FStar_Absyn_Util.bvd_to_bvar_s x t))), (aq)) end -| _62_729 -> begin +| _62_735 -> begin (FStar_All.failwith "Impossible") end)) @@ -707,7 +707,7 @@ end | Some (FStar_Parser_AST.Equality) -> begin Some (FStar_Absyn_Syntax.Equality) end -| _62_736 -> begin +| _62_742 -> begin None end)) @@ -724,8 +724,8 @@ end | FStar_Util.Inl (Some (a), k) -> begin ( -let _62_755 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (match (_62_755) with +let _62_761 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (match (_62_761) with | (env, a) -> begin ((((FStar_Util.Inl ((FStar_Absyn_Util.bvd_to_bvar_s a k))), ((trans_aqual imp)))), (env)) end)) @@ -733,8 +733,8 @@ end | FStar_Util.Inr (Some (x), t) -> begin ( -let _62_763 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) -in (match (_62_763) with +let _62_769 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) +in (match (_62_769) with | (env, x) -> begin ((((FStar_Util.Inr ((FStar_Absyn_Util.bvd_to_bvar_s x t))), ((trans_aqual imp)))), (env)) end)) @@ -757,7 +757,7 @@ let msg = (match (label_opt) with | Some (l) -> begin l end -| _62_773 -> begin +| _62_779 -> begin (let _157_213 = (FStar_Range.string_of_range f.FStar_Parser_AST.range) in (FStar_Util.format2 "%s at %s" tag _157_213)) end) @@ -792,13 +792,13 @@ in ((binders), (_157_228))) in FStar_Parser_AST.Abs (_157_229)) in (FStar_Parser_AST.mk_term _157_230 f.FStar_Parser_AST.range f.FStar_Parser_AST.level)) end -| _62_795 -> begin +| _62_801 -> begin (label f) end)) in (aux f)))) -let mk_lb : (FStar_Absyn_Syntax.lbname * FStar_Absyn_Syntax.typ * FStar_Absyn_Syntax.exp) -> FStar_Absyn_Syntax.letbinding = (fun _62_799 -> (match (_62_799) with +let mk_lb : (FStar_Absyn_Syntax.lbname * FStar_Absyn_Syntax.typ * FStar_Absyn_Syntax.exp) -> FStar_Absyn_Syntax.letbinding = (fun _62_805 -> (match (_62_805) with | (n, t, e) -> begin {FStar_Absyn_Syntax.lbname = n; FStar_Absyn_Syntax.lbtyp = t; FStar_Absyn_Syntax.lbeff = FStar_Absyn_Const.effect_ALL_lid; FStar_Absyn_Syntax.lbdef = e} end)) @@ -810,17 +810,17 @@ let resolvex = (fun l e x -> (match ((FStar_All.pipe_right l (FStar_Util.find_op | FStar_Util.Inr (y) -> begin (y.FStar_Absyn_Syntax.ppname.FStar_Ident.idText = x.FStar_Ident.idText) end -| _62_810 -> begin +| _62_816 -> begin false end))))) with | Some (FStar_Util.Inr (y)) -> begin ((l), (e), (y)) end -| _62_815 -> begin +| _62_821 -> begin ( -let _62_818 = (FStar_Parser_DesugarEnv.push_local_vbinding e x) -in (match (_62_818) with +let _62_824 = (FStar_Parser_DesugarEnv.push_local_vbinding e x) +in (match (_62_824) with | (e, x) -> begin (((FStar_Util.Inr (x))::l), (e), (x)) end)) @@ -831,17 +831,17 @@ let resolvea = (fun l e a -> (match ((FStar_All.pipe_right l (FStar_Util.find_op | FStar_Util.Inl (b) -> begin (b.FStar_Absyn_Syntax.ppname.FStar_Ident.idText = a.FStar_Ident.idText) end -| _62_827 -> begin +| _62_833 -> begin false end))))) with | Some (FStar_Util.Inl (b)) -> begin ((l), (e), (b)) end -| _62_832 -> begin +| _62_838 -> begin ( -let _62_835 = (FStar_Parser_DesugarEnv.push_local_tbinding e a) -in (match (_62_835) with +let _62_841 = (FStar_Parser_DesugarEnv.push_local_tbinding e a) +in (match (_62_841) with | (e, a) -> begin (((FStar_Util.Inl (a))::l), (e), (a)) end)) @@ -855,7 +855,7 @@ in ( let pos_r = (fun r q -> (FStar_Absyn_Syntax.withinfo q None r)) in (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatOp (_62_846) -> begin +| FStar_Parser_AST.PatOp (_62_852) -> begin (FStar_All.failwith "let op not supported in stratified") end | FStar_Parser_AST.PatOr ([]) -> begin @@ -864,30 +864,30 @@ end | FStar_Parser_AST.PatOr ((p)::ps) -> begin ( -let _62_860 = (aux loc env p) -in (match (_62_860) with -| (loc, env, var, p, _62_859) -> begin +let _62_866 = (aux loc env p) +in (match (_62_866) with +| (loc, env, var, p, _62_865) -> begin ( -let _62_877 = (FStar_List.fold_left (fun _62_864 p -> (match (_62_864) with +let _62_883 = (FStar_List.fold_left (fun _62_870 p -> (match (_62_870) with | (loc, env, ps) -> begin ( -let _62_873 = (aux loc env p) -in (match (_62_873) with -| (loc, env, _62_869, p, _62_872) -> begin +let _62_879 = (aux loc env p) +in (match (_62_879) with +| (loc, env, _62_875, p, _62_878) -> begin ((loc), (env), ((p)::ps)) end)) end)) ((loc), (env), ([])) ps) -in (match (_62_877) with +in (match (_62_883) with | (loc, env, ps) -> begin ( let pat = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_disj ((p)::(FStar_List.rev ps)))) in ( -let _62_879 = (let _157_302 = (FStar_Absyn_Syntax.pat_vars pat) -in (Prims.ignore _157_302)) +let _62_885 = (let _157_307 = (FStar_Absyn_Syntax.pat_vars pat) +in (Prims.ignore _157_307)) in ((loc), (env), (var), (pat), (false)))) end)) end)) @@ -897,16 +897,16 @@ end let p = if (is_kind env t) then begin (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatTvar (_62_886) -> begin +| FStar_Parser_AST.PatTvar (_62_892) -> begin p end | FStar_Parser_AST.PatVar (x, imp) -> begin ( -let _62_892 = p -in {FStar_Parser_AST.pat = FStar_Parser_AST.PatTvar (((x), (imp))); FStar_Parser_AST.prange = _62_892.FStar_Parser_AST.prange}) +let _62_898 = p +in {FStar_Parser_AST.pat = FStar_Parser_AST.PatTvar (((x), (imp))); FStar_Parser_AST.prange = _62_898.FStar_Parser_AST.prange}) end -| _62_895 -> begin +| _62_901 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected pattern"), (p.FStar_Parser_AST.prange))))) end) end else begin @@ -914,27 +914,27 @@ p end in ( -let _62_902 = (aux loc env p) -in (match (_62_902) with +let _62_908 = (aux loc env p) +in (match (_62_908) with | (loc, env', binder, p, imp) -> begin ( let binder = (match (binder) with -| LetBinder (_62_904) -> begin +| LetBinder (_62_910) -> begin (FStar_All.failwith "impossible") end -| TBinder (x, _62_908, aq) -> begin -(let _157_304 = (let _157_303 = (desugar_kind env t) -in ((x), (_157_303), (aq))) -in TBinder (_157_304)) +| TBinder (x, _62_914, aq) -> begin +(let _157_309 = (let _157_308 = (desugar_kind env t) +in ((x), (_157_308), (aq))) +in TBinder (_157_309)) end -| VBinder (x, _62_914, aq) -> begin +| VBinder (x, _62_920, aq) -> begin ( let t = (close_fun env t) -in (let _157_306 = (let _157_305 = (desugar_typ env t) -in ((x), (_157_305), (aq))) -in VBinder (_157_306))) +in (let _157_311 = (let _157_310 = (desugar_typ env t) +in ((x), (_157_310), (aq))) +in VBinder (_157_311))) end) in ((loc), (env'), (binder), (p), (imp))) end))) @@ -950,16 +950,16 @@ in if (a.FStar_Ident.idText = "\'_") then begin ( let a = (FStar_All.pipe_left FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_307 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_twild ((FStar_Absyn_Util.bvd_to_bvar_s a FStar_Absyn_Syntax.kun)))) -in ((loc), (env), (TBinder (((a), (FStar_Absyn_Syntax.kun), (aq)))), (_157_307), (imp)))) +in (let _157_312 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_twild ((FStar_Absyn_Util.bvd_to_bvar_s a FStar_Absyn_Syntax.kun)))) +in ((loc), (env), (TBinder (((a), (FStar_Absyn_Syntax.kun), (aq)))), (_157_312), (imp)))) end else begin ( -let _62_930 = (resolvea loc env a) -in (match (_62_930) with +let _62_936 = (resolvea loc env a) +in (match (_62_936) with | (loc, env, abvd) -> begin -(let _157_308 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_tvar ((FStar_Absyn_Util.bvd_to_bvar_s abvd FStar_Absyn_Syntax.kun)))) -in ((loc), (env), (TBinder (((abvd), (FStar_Absyn_Syntax.kun), (aq)))), (_157_308), (imp))) +(let _157_313 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_tvar ((FStar_Absyn_Util.bvd_to_bvar_s abvd FStar_Absyn_Syntax.kun)))) +in ((loc), (env), (TBinder (((abvd), (FStar_Absyn_Syntax.kun), (aq)))), (_157_313), (imp))) end)) end)) end @@ -970,15 +970,15 @@ let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) in ( let y = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_309 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_wild ((FStar_Absyn_Util.bvd_to_bvar_s y FStar_Absyn_Syntax.tun)))) -in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_309), (false))))) +in (let _157_314 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_wild ((FStar_Absyn_Util.bvd_to_bvar_s y FStar_Absyn_Syntax.tun)))) +in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_314), (false))))) end | FStar_Parser_AST.PatConst (c) -> begin ( let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_310 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_constant (c))) -in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_310), (false)))) +in (let _157_315 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_constant (c))) +in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_315), (false)))) end | FStar_Parser_AST.PatVar (x, aq) -> begin ( @@ -989,11 +989,11 @@ in ( let aq = (trans_aqual aq) in ( -let _62_946 = (resolvex loc env x) -in (match (_62_946) with +let _62_952 = (resolvex loc env x) +in (match (_62_952) with | (loc, env, xbvd) -> begin -(let _157_311 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_var ((FStar_Absyn_Util.bvd_to_bvar_s xbvd FStar_Absyn_Syntax.tun)))) -in ((loc), (env), (VBinder (((xbvd), (FStar_Absyn_Syntax.tun), (aq)))), (_157_311), (imp))) +(let _157_316 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_var ((FStar_Absyn_Util.bvd_to_bvar_s xbvd FStar_Absyn_Syntax.tun)))) +in ((loc), (env), (VBinder (((xbvd), (FStar_Absyn_Syntax.tun), (aq)))), (_157_316), (imp))) end)))) end | FStar_Parser_AST.PatName (l) -> begin @@ -1003,23 +1003,23 @@ let l = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup in ( let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_312 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), ([]))))) -in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_312), (false))))) +in (let _157_317 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), ([]))))) +in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_317), (false))))) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatName (l); FStar_Parser_AST.prange = _62_952}, args) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatName (l); FStar_Parser_AST.prange = _62_958}, args) -> begin ( -let _62_974 = (FStar_List.fold_right (fun arg _62_963 -> (match (_62_963) with +let _62_980 = (FStar_List.fold_right (fun arg _62_969 -> (match (_62_969) with | (loc, env, args) -> begin ( -let _62_970 = (aux loc env arg) -in (match (_62_970) with -| (loc, env, _62_967, arg, imp) -> begin +let _62_976 = (aux loc env arg) +in (match (_62_976) with +| (loc, env, _62_973, arg, imp) -> begin ((loc), (env), ((((arg), (imp)))::args)) end)) end)) args ((loc), (env), ([]))) -in (match (_62_974) with +in (match (_62_980) with | (loc, env, args) -> begin ( @@ -1027,37 +1027,37 @@ let l = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup in ( let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_315 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), (args))))) -in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_315), (false))))) +in (let _157_320 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), (args))))) +in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_320), (false))))) end)) end -| FStar_Parser_AST.PatApp (_62_978) -> begin +| FStar_Parser_AST.PatApp (_62_984) -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected pattern"), (p.FStar_Parser_AST.prange))))) end | FStar_Parser_AST.PatList (pats) -> begin ( -let _62_998 = (FStar_List.fold_right (fun pat _62_986 -> (match (_62_986) with +let _62_1004 = (FStar_List.fold_right (fun pat _62_992 -> (match (_62_992) with | (loc, env, pats) -> begin ( -let _62_994 = (aux loc env pat) -in (match (_62_994) with -| (loc, env, _62_990, pat, _62_993) -> begin +let _62_1000 = (aux loc env pat) +in (match (_62_1000) with +| (loc, env, _62_996, pat, _62_999) -> begin ((loc), (env), ((pat)::pats)) end)) end)) pats ((loc), (env), ([]))) -in (match (_62_998) with +in (match (_62_1004) with | (loc, env, pats) -> begin ( -let pat = (let _157_322 = (let _157_321 = (let _157_320 = (FStar_Range.end_range p.FStar_Parser_AST.prange) -in (pos_r _157_320)) -in (FStar_All.pipe_left _157_321 (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv FStar_Absyn_Const.nil_lid)), (Some (FStar_Absyn_Syntax.Data_ctor)), ([])))))) +let pat = (let _157_327 = (let _157_326 = (let _157_325 = (FStar_Range.end_range p.FStar_Parser_AST.prange) +in (pos_r _157_325)) +in (FStar_All.pipe_left _157_326 (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv FStar_Absyn_Const.nil_lid)), (Some (FStar_Absyn_Syntax.Data_ctor)), ([])))))) in (FStar_List.fold_right (fun hd tl -> ( let r = (FStar_Range.union_ranges hd.FStar_Absyn_Syntax.p tl.FStar_Absyn_Syntax.p) -in (FStar_All.pipe_left (pos_r r) (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv FStar_Absyn_Const.cons_lid)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((((hd), (false)))::(((tl), (false)))::[]))))))) pats _157_322)) +in (FStar_All.pipe_left (pos_r r) (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv FStar_Absyn_Const.cons_lid)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((((hd), (false)))::(((tl), (false)))::[]))))))) pats _157_327)) in ( let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) @@ -1067,17 +1067,17 @@ end | FStar_Parser_AST.PatTuple (args, dep) -> begin ( -let _62_1024 = (FStar_List.fold_left (fun _62_1011 p -> (match (_62_1011) with +let _62_1030 = (FStar_List.fold_left (fun _62_1017 p -> (match (_62_1017) with | (loc, env, pats) -> begin ( -let _62_1020 = (aux loc env p) -in (match (_62_1020) with -| (loc, env, _62_1016, pat, _62_1019) -> begin +let _62_1026 = (aux loc env p) +in (match (_62_1026) with +| (loc, env, _62_1022, pat, _62_1025) -> begin ((loc), (env), ((((pat), (false)))::pats)) end)) end)) ((loc), (env), ([])) args) -in (match (_62_1024) with +in (match (_62_1030) with | (loc, env, args) -> begin ( @@ -1095,17 +1095,17 @@ let constr = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_l in ( let l = (match (constr.FStar_Absyn_Syntax.n) with -| FStar_Absyn_Syntax.Exp_fvar (v, _62_1030) -> begin +| FStar_Absyn_Syntax.Exp_fvar (v, _62_1036) -> begin v end -| _62_1034 -> begin +| _62_1040 -> begin (FStar_All.failwith "impossible") end) in ( let x = (FStar_Absyn_Util.new_bvd (Some (p.FStar_Parser_AST.prange))) -in (let _157_325 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), (args))))) -in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_325), (false)))))))) +in (let _157_330 = (FStar_All.pipe_left pos (FStar_Absyn_Syntax.Pat_cons (((l), (Some (FStar_Absyn_Syntax.Data_ctor)), (args))))) +in ((loc), (env), (VBinder (((x), (FStar_Absyn_Syntax.tun), (None)))), (_157_330), (false)))))))) end)) end | FStar_Parser_AST.PatRecord ([]) -> begin @@ -1114,33 +1114,33 @@ end | FStar_Parser_AST.PatRecord (fields) -> begin ( -let _62_1044 = (FStar_List.hd fields) -in (match (_62_1044) with -| (f, _62_1043) -> begin +let _62_1050 = (FStar_List.hd fields) +in (match (_62_1050) with +| (f, _62_1049) -> begin ( -let _62_1048 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_record_by_field_name env) f) -in (match (_62_1048) with -| (record, _62_1047) -> begin +let _62_1054 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_record_by_field_name env) f) +in (match (_62_1054) with +| (record, _62_1053) -> begin ( -let fields = (FStar_All.pipe_right fields (FStar_List.map (fun _62_1051 -> (match (_62_1051) with +let fields = (FStar_All.pipe_right fields (FStar_List.map (fun _62_1057 -> (match (_62_1057) with | (f, p) -> begin -(let _157_327 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.qualify_field_to_record env record) f) -in ((_157_327), (p))) +(let _157_332 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.qualify_field_to_record env record) f) +in ((_157_332), (p))) end)))) in ( -let args = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1056 -> (match (_62_1056) with -| (f, _62_1055) -> begin -(match ((FStar_All.pipe_right fields (FStar_List.tryFind (fun _62_1060 -> (match (_62_1060) with -| (g, _62_1059) -> begin +let args = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1062 -> (match (_62_1062) with +| (f, _62_1061) -> begin +(match ((FStar_All.pipe_right fields (FStar_List.tryFind (fun _62_1066 -> (match (_62_1066) with +| (g, _62_1065) -> begin (FStar_Ident.lid_equals f g) end))))) with | None -> begin (FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild p.FStar_Parser_AST.prange) end -| Some (_62_1063, p) -> begin +| Some (_62_1069, p) -> begin p end) end)))) @@ -1149,22 +1149,22 @@ in ( let app = (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatApp ((((FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatName (record.FStar_Parser_DesugarEnv.constrname)) p.FStar_Parser_AST.prange)), (args)))) p.FStar_Parser_AST.prange) in ( -let _62_1075 = (aux loc env app) -in (match (_62_1075) with -| (env, e, b, p, _62_1074) -> begin +let _62_1081 = (aux loc env app) +in (match (_62_1081) with +| (env, e, b, p, _62_1080) -> begin ( let p = (match (p.FStar_Absyn_Syntax.v) with -| FStar_Absyn_Syntax.Pat_cons (fv, _62_1078, args) -> begin -(let _157_335 = (let _157_334 = (let _157_333 = (let _157_332 = (let _157_331 = (let _157_330 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map Prims.fst)) -in ((record.FStar_Parser_DesugarEnv.typename), (_157_330))) -in FStar_Absyn_Syntax.Record_ctor (_157_331)) -in Some (_157_332)) -in ((fv), (_157_333), (args))) -in FStar_Absyn_Syntax.Pat_cons (_157_334)) -in (FStar_All.pipe_left pos _157_335)) -end -| _62_1083 -> begin +| FStar_Absyn_Syntax.Pat_cons (fv, _62_1084, args) -> begin +(let _157_340 = (let _157_339 = (let _157_338 = (let _157_337 = (let _157_336 = (let _157_335 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map Prims.fst)) +in ((record.FStar_Parser_DesugarEnv.typename), (_157_335))) +in FStar_Absyn_Syntax.Record_ctor (_157_336)) +in Some (_157_337)) +in ((fv), (_157_338), (args))) +in FStar_Absyn_Syntax.Pat_cons (_157_339)) +in (FStar_All.pipe_left pos _157_340)) +end +| _62_1089 -> begin p end) in ((env), (e), (b), (p), (false))) @@ -1174,34 +1174,34 @@ end)) end)))) in ( -let _62_1092 = (aux [] env p) -in (match (_62_1092) with -| (_62_1086, env, b, p, _62_1091) -> begin +let _62_1098 = (aux [] env p) +in (match (_62_1098) with +| (_62_1092, env, b, p, _62_1097) -> begin ((env), (b), (p)) end)))))) and desugar_binding_pat_maybe_top : Prims.bool -> FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.pattern -> (env_t * bnd * FStar_Absyn_Syntax.pat Prims.option) = (fun top env p -> if top then begin (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatVar (x, _62_1098) -> begin -(let _157_341 = (let _157_340 = (let _157_339 = (FStar_Parser_DesugarEnv.qualify env x) -in ((_157_339), (FStar_Absyn_Syntax.tun))) -in LetBinder (_157_340)) -in ((env), (_157_341), (None))) -end -| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (x, _62_1105); FStar_Parser_AST.prange = _62_1102}, t) -> begin -(let _157_345 = (let _157_344 = (let _157_343 = (FStar_Parser_DesugarEnv.qualify env x) -in (let _157_342 = (desugar_typ env t) -in ((_157_343), (_157_342)))) -in LetBinder (_157_344)) -in ((env), (_157_345), (None))) -end -| _62_1113 -> begin +| FStar_Parser_AST.PatVar (x, _62_1104) -> begin +(let _157_346 = (let _157_345 = (let _157_344 = (FStar_Parser_DesugarEnv.qualify env x) +in ((_157_344), (FStar_Absyn_Syntax.tun))) +in LetBinder (_157_345)) +in ((env), (_157_346), (None))) +end +| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (x, _62_1111); FStar_Parser_AST.prange = _62_1108}, t) -> begin +(let _157_350 = (let _157_349 = (let _157_348 = (FStar_Parser_DesugarEnv.qualify env x) +in (let _157_347 = (desugar_typ env t) +in ((_157_348), (_157_347)))) +in LetBinder (_157_349)) +in ((env), (_157_350), (None))) +end +| _62_1119 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected pattern at the top-level"), (p.FStar_Parser_AST.prange))))) end) end else begin ( -let _62_1117 = (desugar_data_pat env p) -in (match (_62_1117) with +let _62_1123 = (desugar_data_pat env p) +in (match (_62_1123) with | (env, binder, p) -> begin ( @@ -1209,29 +1209,41 @@ let p = (match (p.FStar_Absyn_Syntax.v) with | (FStar_Absyn_Syntax.Pat_var (_)) | (FStar_Absyn_Syntax.Pat_tvar (_)) | (FStar_Absyn_Syntax.Pat_wild (_)) -> begin None end -| _62_1128 -> begin +| _62_1134 -> begin Some (p) end) in ((env), (binder), (p))) end)) end) and desugar_binding_pat : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.pattern -> (env_t * bnd * FStar_Absyn_Syntax.pat Prims.option) = (fun env p -> (desugar_binding_pat_maybe_top false env p)) -and desugar_match_pat_maybe_top : Prims.bool -> FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Absyn_Syntax.pat) = (fun _62_1132 env pat -> ( +and desugar_match_pat_maybe_top : Prims.bool -> FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Absyn_Syntax.pat) = (fun _62_1138 env pat -> ( -let _62_1140 = (desugar_data_pat env pat) -in (match (_62_1140) with -| (env, _62_1138, pat) -> begin +let _62_1146 = (desugar_data_pat env pat) +in (match (_62_1146) with +| (env, _62_1144, pat) -> begin ((env), (pat)) end))) and desugar_match_pat : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Absyn_Syntax.pat) = (fun env p -> (desugar_match_pat_maybe_top false env p)) and desugar_typ_or_exp : env_t -> FStar_Parser_AST.term -> (FStar_Absyn_Syntax.typ, FStar_Absyn_Syntax.exp) FStar_Util.either = (fun env t -> if (is_type env t) then begin -(let _157_355 = (desugar_typ env t) -in FStar_Util.Inl (_157_355)) +(let _157_360 = (desugar_typ env t) +in FStar_Util.Inl (_157_360)) end else begin -(let _157_356 = (desugar_exp env t) -in FStar_Util.Inr (_157_356)) +(let _157_361 = (desugar_exp env t) +in FStar_Util.Inr (_157_361)) end) and desugar_exp : env_t -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.exp = (fun env e -> (desugar_exp_maybe_top false env e)) +and desugar_name : (FStar_Absyn_Syntax.exp -> (FStar_Absyn_Syntax.exp', (FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) -> FStar_Parser_DesugarEnv.env -> FStar_Ident.lident -> (FStar_Absyn_Syntax.exp', (FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax = (fun setpos env l -> if (l.FStar_Ident.str = "ref") then begin +(match ((FStar_Parser_DesugarEnv.try_lookup_lid env FStar_Absyn_Const.alloc_lid)) with +| None -> begin +(Prims.raise (FStar_Absyn_Syntax.Error ((("Identifier \'ref\' not found; include lib/FStar.ST.fst in your path"), ((FStar_Ident.range_of_lid l)))))) +end +| Some (e) -> begin +(setpos e) +end) +end else begin +(let _157_370 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_lid env) l) +in (FStar_All.pipe_left setpos _157_370)) +end) and desugar_exp_maybe_top : Prims.bool -> env_t -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.exp = (fun top_level env top -> ( let pos = (fun e -> (e None top.FStar_Parser_AST.range)) @@ -1239,10 +1251,10 @@ in ( let setpos = (fun e -> ( -let _62_1154 = e -in {FStar_Absyn_Syntax.n = _62_1154.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1154.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = top.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1154.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1154.FStar_Absyn_Syntax.uvs})) -in (match ((let _157_376 = (unparen top) -in _157_376.FStar_Parser_AST.tm)) with +let _62_1166 = e +in {FStar_Absyn_Syntax.n = _62_1166.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1166.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = top.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1166.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1166.FStar_Absyn_Syntax.uvs})) +in (match ((let _157_388 = (unparen top) +in _157_388.FStar_Parser_AST.tm)) with | FStar_Parser_AST.Const (c) -> begin (FStar_All.pipe_left pos (FStar_Absyn_Syntax.mk_Exp_constant c)) end @@ -1257,92 +1269,81 @@ end let op = (FStar_Absyn_Util.fvar None l (FStar_Ident.range_of_lid l)) in ( -let args = (FStar_All.pipe_right args (FStar_List.map (fun t -> (let _157_380 = (desugar_typ_or_exp env t) -in ((_157_380), (None)))))) -in (let _157_381 = (FStar_Absyn_Util.mk_exp_app op args) -in (FStar_All.pipe_left setpos _157_381)))) +let args = (FStar_All.pipe_right args (FStar_List.map (fun t -> (let _157_392 = (desugar_typ_or_exp env t) +in ((_157_392), (None)))))) +in (let _157_393 = (FStar_Absyn_Util.mk_exp_app op args) +in (FStar_All.pipe_left setpos _157_393)))) end) end | (FStar_Parser_AST.Var (l)) | (FStar_Parser_AST.Name (l)) -> begin -if (l.FStar_Ident.str = "ref") then begin -(match ((FStar_Parser_DesugarEnv.try_lookup_lid env FStar_Absyn_Const.alloc_lid)) with -| None -> begin -(Prims.raise (FStar_Absyn_Syntax.Error ((("Identifier \'ref\' not found; include lib/FStar.ST.fst in your path"), ((FStar_Ident.range_of_lid l)))))) -end -| Some (e) -> begin -(setpos e) -end) -end else begin -(let _157_382 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_lid env) l) -in (FStar_All.pipe_left setpos _157_382)) -end +(desugar_name setpos env l) end | FStar_Parser_AST.Construct (l, args) -> begin ( -let dt = (let _157_387 = (let _157_386 = (let _157_385 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_datacon env) l) -in ((_157_385), (Some (FStar_Absyn_Syntax.Data_ctor)))) -in (FStar_Absyn_Syntax.mk_Exp_fvar _157_386)) -in (FStar_All.pipe_left pos _157_387)) +let dt = (let _157_398 = (let _157_397 = (let _157_396 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_datacon env) l) +in ((_157_396), (Some (FStar_Absyn_Syntax.Data_ctor)))) +in (FStar_Absyn_Syntax.mk_Exp_fvar _157_397)) +in (FStar_All.pipe_left pos _157_398)) in (match (args) with | [] -> begin dt end -| _62_1181 -> begin +| _62_1190 -> begin ( -let args = (FStar_List.map (fun _62_1184 -> (match (_62_1184) with +let args = (FStar_List.map (fun _62_1193 -> (match (_62_1193) with | (t, imp) -> begin ( let te = (desugar_typ_or_exp env t) in (arg_withimp_e imp te)) end)) args) -in (let _157_392 = (let _157_391 = (let _157_390 = (let _157_389 = (FStar_Absyn_Util.mk_exp_app dt args) -in ((_157_389), (FStar_Absyn_Syntax.Data_app))) -in FStar_Absyn_Syntax.Meta_desugared (_157_390)) -in (FStar_Absyn_Syntax.mk_Exp_meta _157_391)) -in (FStar_All.pipe_left setpos _157_392))) +in (let _157_403 = (let _157_402 = (let _157_401 = (let _157_400 = (FStar_Absyn_Util.mk_exp_app dt args) +in ((_157_400), (FStar_Absyn_Syntax.Data_app))) +in FStar_Absyn_Syntax.Meta_desugared (_157_401)) +in (FStar_Absyn_Syntax.mk_Exp_meta _157_402)) +in (FStar_All.pipe_left setpos _157_403))) end)) end | FStar_Parser_AST.Abs (binders, body) -> begin ( -let _62_1221 = (FStar_List.fold_left (fun _62_1193 pat -> (match (_62_1193) with +let _62_1230 = (FStar_List.fold_left (fun _62_1202 pat -> (match (_62_1202) with | (env, ftvs) -> begin (match (pat.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatTvar (a, imp); FStar_Parser_AST.prange = _62_1196}, t) -> begin +| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatTvar (a, imp); FStar_Parser_AST.prange = _62_1205}, t) -> begin ( -let ftvs = (let _157_395 = (free_type_vars env t) -in (FStar_List.append _157_395 ftvs)) -in (let _157_397 = (let _157_396 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (FStar_All.pipe_left Prims.fst _157_396)) -in ((_157_397), (ftvs)))) +let ftvs = (let _157_406 = (free_type_vars env t) +in (FStar_List.append _157_406 ftvs)) +in (let _157_408 = (let _157_407 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (FStar_All.pipe_left Prims.fst _157_407)) +in ((_157_408), (ftvs)))) end -| FStar_Parser_AST.PatTvar (a, _62_1208) -> begin -(let _157_399 = (let _157_398 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (FStar_All.pipe_left Prims.fst _157_398)) -in ((_157_399), (ftvs))) +| FStar_Parser_AST.PatTvar (a, _62_1217) -> begin +(let _157_410 = (let _157_409 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (FStar_All.pipe_left Prims.fst _157_409)) +in ((_157_410), (ftvs))) end -| FStar_Parser_AST.PatAscribed (_62_1212, t) -> begin -(let _157_401 = (let _157_400 = (free_type_vars env t) -in (FStar_List.append _157_400 ftvs)) -in ((env), (_157_401))) +| FStar_Parser_AST.PatAscribed (_62_1221, t) -> begin +(let _157_412 = (let _157_411 = (free_type_vars env t) +in (FStar_List.append _157_411 ftvs)) +in ((env), (_157_412))) end -| _62_1217 -> begin +| _62_1226 -> begin ((env), (ftvs)) end) end)) ((env), ([])) binders) -in (match (_62_1221) with -| (_62_1219, ftv) -> begin +in (match (_62_1230) with +| (_62_1228, ftv) -> begin ( let ftv = (sort_ftv ftv) in ( -let binders = (let _157_403 = (FStar_All.pipe_right ftv (FStar_List.map (fun a -> (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatTvar (((a), (Some (FStar_Parser_AST.Implicit))))) top.FStar_Parser_AST.range)))) -in (FStar_List.append _157_403 binders)) +let binders = (let _157_414 = (FStar_All.pipe_right ftv (FStar_List.map (fun a -> (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatTvar (((a), (Some (FStar_Parser_AST.Implicit))))) top.FStar_Parser_AST.range)))) +in (FStar_List.append _157_414 binders)) in ( let rec aux = (fun env bs sc_pat_opt _62_8 -> (match (_62_8) with @@ -1364,18 +1365,18 @@ end | (p)::rest -> begin ( -let _62_1244 = (desugar_binding_pat env p) -in (match (_62_1244) with +let _62_1253 = (desugar_binding_pat env p) +in (match (_62_1253) with | (env, b, pat) -> begin ( -let _62_1304 = (match (b) with -| LetBinder (_62_1246) -> begin +let _62_1313 = (match (b) with +| LetBinder (_62_1255) -> begin (FStar_All.failwith "Impossible") end | TBinder (a, k, aq) -> begin -(let _157_412 = (binder_of_bnd b) -in ((_157_412), (sc_pat_opt))) +(let _157_423 = (binder_of_bnd b) +in ((_157_423), (sc_pat_opt))) end | VBinder (x, t, aq) -> begin ( @@ -1384,62 +1385,62 @@ let b = (FStar_Absyn_Util.bvd_to_bvar_s x t) in ( let sc_pat_opt = (match (((pat), (sc_pat_opt))) with -| (None, _62_1261) -> begin +| (None, _62_1270) -> begin sc_pat_opt end | (Some (p), None) -> begin -(let _157_414 = (let _157_413 = (FStar_Absyn_Util.bvar_to_exp b) -in ((_157_413), (p))) -in Some (_157_414)) +(let _157_425 = (let _157_424 = (FStar_Absyn_Util.bvar_to_exp b) +in ((_157_424), (p))) +in Some (_157_425)) end | (Some (p), Some (sc, p')) -> begin (match (((sc.FStar_Absyn_Syntax.n), (p'.FStar_Absyn_Syntax.v))) with -| (FStar_Absyn_Syntax.Exp_bvar (_62_1275), _62_1278) -> begin +| (FStar_Absyn_Syntax.Exp_bvar (_62_1284), _62_1287) -> begin ( let tup = (FStar_Absyn_Util.mk_tuple_data_lid (Prims.parse_int "2") top.FStar_Parser_AST.range) in ( -let sc = (let _157_421 = (let _157_420 = (FStar_Absyn_Util.fvar (Some (FStar_Absyn_Syntax.Data_ctor)) tup top.FStar_Parser_AST.range) -in (let _157_419 = (let _157_418 = (FStar_Absyn_Syntax.varg sc) -in (let _157_417 = (let _157_416 = (let _157_415 = (FStar_Absyn_Util.bvar_to_exp b) -in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_415)) -in (_157_416)::[]) -in (_157_418)::_157_417)) -in ((_157_420), (_157_419)))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_421 None top.FStar_Parser_AST.range)) +let sc = (let _157_432 = (let _157_431 = (FStar_Absyn_Util.fvar (Some (FStar_Absyn_Syntax.Data_ctor)) tup top.FStar_Parser_AST.range) +in (let _157_430 = (let _157_429 = (FStar_Absyn_Syntax.varg sc) +in (let _157_428 = (let _157_427 = (let _157_426 = (FStar_Absyn_Util.bvar_to_exp b) +in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_426)) +in (_157_427)::[]) +in (_157_429)::_157_428)) +in ((_157_431), (_157_430)))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_432 None top.FStar_Parser_AST.range)) in ( -let p = (let _157_422 = (FStar_Range.union_ranges p'.FStar_Absyn_Syntax.p p.FStar_Absyn_Syntax.p) -in (FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv tup)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((((p'), (false)))::(((p), (false)))::[])))) None _157_422)) +let p = (let _157_433 = (FStar_Range.union_ranges p'.FStar_Absyn_Syntax.p p.FStar_Absyn_Syntax.p) +in (FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv tup)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((((p'), (false)))::(((p), (false)))::[])))) None _157_433)) in Some (((sc), (p)))))) end -| (FStar_Absyn_Syntax.Exp_app (_62_1284, args), FStar_Absyn_Syntax.Pat_cons (_62_1289, _62_1291, pats)) -> begin +| (FStar_Absyn_Syntax.Exp_app (_62_1293, args), FStar_Absyn_Syntax.Pat_cons (_62_1298, _62_1300, pats)) -> begin ( let tup = (FStar_Absyn_Util.mk_tuple_data_lid ((Prims.parse_int "1") + (FStar_List.length args)) top.FStar_Parser_AST.range) in ( -let sc = (let _157_428 = (let _157_427 = (FStar_Absyn_Util.fvar (Some (FStar_Absyn_Syntax.Data_ctor)) tup top.FStar_Parser_AST.range) -in (let _157_426 = (let _157_425 = (let _157_424 = (let _157_423 = (FStar_Absyn_Util.bvar_to_exp b) -in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_423)) -in (_157_424)::[]) -in (FStar_List.append args _157_425)) -in ((_157_427), (_157_426)))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_428 None top.FStar_Parser_AST.range)) +let sc = (let _157_439 = (let _157_438 = (FStar_Absyn_Util.fvar (Some (FStar_Absyn_Syntax.Data_ctor)) tup top.FStar_Parser_AST.range) +in (let _157_437 = (let _157_436 = (let _157_435 = (let _157_434 = (FStar_Absyn_Util.bvar_to_exp b) +in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_434)) +in (_157_435)::[]) +in (FStar_List.append args _157_436)) +in ((_157_438), (_157_437)))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_439 None top.FStar_Parser_AST.range)) in ( -let p = (let _157_429 = (FStar_Range.union_ranges p'.FStar_Absyn_Syntax.p p.FStar_Absyn_Syntax.p) -in (FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv tup)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((FStar_List.append pats ((((p), (false)))::[])))))) None _157_429)) +let p = (let _157_440 = (FStar_Range.union_ranges p'.FStar_Absyn_Syntax.p p.FStar_Absyn_Syntax.p) +in (FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv tup)), (Some (FStar_Absyn_Syntax.Data_ctor)), ((FStar_List.append pats ((((p), (false)))::[])))))) None _157_440)) in Some (((sc), (p)))))) end -| _62_1300 -> begin +| _62_1309 -> begin (FStar_All.failwith "Impossible") end) end) in ((((FStar_Util.Inr (b)), (aq))), (sc_pat_opt)))) end) -in (match (_62_1304) with +in (match (_62_1313) with | (b, sc_pat_opt) -> begin (aux env ((b)::bs) sc_pat_opt rest) end)) @@ -1448,33 +1449,33 @@ end)) in (aux env [] None binders)))) end)) end -| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (a); FStar_Parser_AST.range = _62_1308; FStar_Parser_AST.level = _62_1306}, arg, _62_1314) when ((FStar_Ident.lid_equals a FStar_Absyn_Const.assert_lid) || (FStar_Ident.lid_equals a FStar_Absyn_Const.assume_lid)) -> begin +| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (a); FStar_Parser_AST.range = _62_1317; FStar_Parser_AST.level = _62_1315}, arg, _62_1323) when ((FStar_Ident.lid_equals a FStar_Absyn_Const.assert_lid) || (FStar_Ident.lid_equals a FStar_Absyn_Const.assume_lid)) -> begin ( let phi = (desugar_formula env arg) -in (let _157_439 = (let _157_438 = (let _157_437 = (FStar_Absyn_Util.fvar None a (FStar_Ident.range_of_lid a)) -in (let _157_436 = (let _157_435 = (FStar_All.pipe_left FStar_Absyn_Syntax.targ phi) -in (let _157_434 = (let _157_433 = (let _157_432 = (FStar_Absyn_Syntax.mk_Exp_constant FStar_Const.Const_unit None top.FStar_Parser_AST.range) -in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_432)) -in (_157_433)::[]) -in (_157_435)::_157_434)) -in ((_157_437), (_157_436)))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_438)) -in (FStar_All.pipe_left pos _157_439))) +in (let _157_450 = (let _157_449 = (let _157_448 = (FStar_Absyn_Util.fvar None a (FStar_Ident.range_of_lid a)) +in (let _157_447 = (let _157_446 = (FStar_All.pipe_left FStar_Absyn_Syntax.targ phi) +in (let _157_445 = (let _157_444 = (let _157_443 = (FStar_Absyn_Syntax.mk_Exp_constant FStar_Const.Const_unit None top.FStar_Parser_AST.range) +in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_443)) +in (_157_444)::[]) +in (_157_446)::_157_445)) +in ((_157_448), (_157_447)))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_449)) +in (FStar_All.pipe_left pos _157_450))) end -| FStar_Parser_AST.App (_62_1319) -> begin +| FStar_Parser_AST.App (_62_1328) -> begin ( -let rec aux = (fun args e -> (match ((let _157_444 = (unparen e) -in _157_444.FStar_Parser_AST.tm)) with +let rec aux = (fun args e -> (match ((let _157_455 = (unparen e) +in _157_455.FStar_Parser_AST.tm)) with | FStar_Parser_AST.App (e, t, imp) -> begin ( -let arg = (let _157_445 = (desugar_typ_or_exp env t) -in (FStar_All.pipe_left (arg_withimp_e imp) _157_445)) +let arg = (let _157_456 = (desugar_typ_or_exp env t) +in (FStar_All.pipe_left (arg_withimp_e imp) _157_456)) in (aux ((arg)::args) e)) end -| _62_1331 -> begin +| _62_1340 -> begin ( let head = (desugar_exp env e) @@ -1483,13 +1484,13 @@ end)) in (aux [] top)) end | FStar_Parser_AST.Seq (t1, t2) -> begin -(let _157_451 = (let _157_450 = (let _157_449 = (let _157_448 = (desugar_exp env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild t1.FStar_Parser_AST.range)), (t1)))::[]), (t2)))) top.FStar_Parser_AST.range FStar_Parser_AST.Expr)) -in ((_157_448), (FStar_Absyn_Syntax.Sequence))) -in FStar_Absyn_Syntax.Meta_desugared (_157_449)) -in (FStar_Absyn_Syntax.mk_Exp_meta _157_450)) -in (FStar_All.pipe_left setpos _157_451)) +(let _157_462 = (let _157_461 = (let _157_460 = (let _157_459 = (desugar_exp env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild t1.FStar_Parser_AST.range)), (t1)))::[]), (t2)))) top.FStar_Parser_AST.range FStar_Parser_AST.Expr)) +in ((_157_459), (FStar_Absyn_Syntax.Sequence))) +in FStar_Absyn_Syntax.Meta_desugared (_157_460)) +in (FStar_Absyn_Syntax.mk_Exp_meta _157_461)) +in (FStar_All.pipe_left setpos _157_462)) end -| FStar_Parser_AST.LetOpen (_62_1338) -> begin +| FStar_Parser_AST.LetOpen (_62_1347) -> begin (FStar_All.failwith "let open in universes") end | FStar_Parser_AST.Let (is_rec, ((pat, _snd))::_tl, body) -> begin @@ -1498,47 +1499,47 @@ end let is_rec = (is_rec = FStar_Parser_AST.Rec) in ( -let ds_let_rec = (fun _62_1351 -> (match (()) with +let ds_let_rec = (fun _62_1360 -> (match (()) with | () -> begin ( let bindings = (((pat), (_snd)))::_tl in ( -let funs = (FStar_All.pipe_right bindings (FStar_List.map (fun _62_1355 -> (match (_62_1355) with +let funs = (FStar_All.pipe_right bindings (FStar_List.map (fun _62_1364 -> (match (_62_1364) with | (p, def) -> begin if (is_app_pattern p) then begin -(let _157_455 = (destruct_app_pattern env top_level p) -in ((_157_455), (def))) +(let _157_466 = (destruct_app_pattern env top_level p) +in ((_157_466), (def))) end else begin (match ((FStar_Parser_AST.un_function p def)) with | Some (p, def) -> begin -(let _157_456 = (destruct_app_pattern env top_level p) -in ((_157_456), (def))) +(let _157_467 = (destruct_app_pattern env top_level p) +in ((_157_467), (def))) end -| _62_1361 -> begin +| _62_1370 -> begin (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_1366); FStar_Parser_AST.prange = _62_1363}, t) -> begin +| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _62_1375); FStar_Parser_AST.prange = _62_1372}, t) -> begin if top_level then begin -(let _157_459 = (let _157_458 = (let _157_457 = (FStar_Parser_DesugarEnv.qualify env id) -in FStar_Util.Inr (_157_457)) -in ((_157_458), ([]), (Some (t)))) -in ((_157_459), (def))) +(let _157_470 = (let _157_469 = (let _157_468 = (FStar_Parser_DesugarEnv.qualify env id) +in FStar_Util.Inr (_157_468)) +in ((_157_469), ([]), (Some (t)))) +in ((_157_470), (def))) end else begin ((((FStar_Util.Inl (id)), ([]), (Some (t)))), (def)) end end -| FStar_Parser_AST.PatVar (id, _62_1375) -> begin +| FStar_Parser_AST.PatVar (id, _62_1384) -> begin if top_level then begin -(let _157_462 = (let _157_461 = (let _157_460 = (FStar_Parser_DesugarEnv.qualify env id) -in FStar_Util.Inr (_157_460)) -in ((_157_461), ([]), (None))) -in ((_157_462), (def))) +(let _157_473 = (let _157_472 = (let _157_471 = (FStar_Parser_DesugarEnv.qualify env id) +in FStar_Util.Inr (_157_471)) +in ((_157_472), ([]), (None))) +in ((_157_473), (def))) end else begin ((((FStar_Util.Inl (id)), ([]), (None))), (def)) end end -| _62_1379 -> begin +| _62_1388 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected let binding"), (p.FStar_Parser_AST.prange))))) end) end) @@ -1546,38 +1547,38 @@ end end)))) in ( -let _62_1405 = (FStar_List.fold_left (fun _62_1383 _62_1392 -> (match (((_62_1383), (_62_1392))) with -| ((env, fnames), ((f, _62_1386, _62_1388), _62_1391)) -> begin +let _62_1414 = (FStar_List.fold_left (fun _62_1392 _62_1401 -> (match (((_62_1392), (_62_1401))) with +| ((env, fnames), ((f, _62_1395, _62_1397), _62_1400)) -> begin ( -let _62_1402 = (match (f) with +let _62_1411 = (match (f) with | FStar_Util.Inl (x) -> begin ( -let _62_1397 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) -in (match (_62_1397) with +let _62_1406 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) +in (match (_62_1406) with | (env, xx) -> begin ((env), (FStar_Util.Inl (xx))) end)) end | FStar_Util.Inr (l) -> begin -(let _157_465 = (FStar_Parser_DesugarEnv.push_rec_binding env (FStar_Parser_DesugarEnv.Binding_let (l))) -in ((_157_465), (FStar_Util.Inr (l)))) +(let _157_476 = (FStar_Parser_DesugarEnv.push_rec_binding env (FStar_Parser_DesugarEnv.Binding_let (l))) +in ((_157_476), (FStar_Util.Inr (l)))) end) -in (match (_62_1402) with +in (match (_62_1411) with | (env, lbname) -> begin ((env), ((lbname)::fnames)) end)) end)) ((env), ([])) funs) -in (match (_62_1405) with +in (match (_62_1414) with | (env', fnames) -> begin ( let fnames = (FStar_List.rev fnames) in ( -let desugar_one_def = (fun env lbname _62_1416 -> (match (_62_1416) with -| ((_62_1411, args, result_t), def) -> begin +let desugar_one_def = (fun env lbname _62_1425 -> (match (_62_1425) with +| ((_62_1420, args, result_t), def) -> begin ( let def = (match (result_t) with @@ -1585,8 +1586,8 @@ let def = (match (result_t) with def end | Some (t) -> begin -(let _157_472 = (FStar_Range.union_ranges t.FStar_Parser_AST.range def.FStar_Parser_AST.range) -in (FStar_Parser_AST.mk_term (FStar_Parser_AST.Ascribed (((def), (t)))) _157_472 FStar_Parser_AST.Expr)) +(let _157_483 = (FStar_Range.union_ranges t.FStar_Parser_AST.range def.FStar_Parser_AST.range) +in (FStar_Parser_AST.mk_term (FStar_Parser_AST.Ascribed (((def), (t)))) _157_483 FStar_Parser_AST.Expr)) end) in ( @@ -1594,7 +1595,7 @@ let def = (match (args) with | [] -> begin def end -| _62_1423 -> begin +| _62_1432 -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.un_curry_abs args def) top.FStar_Parser_AST.range top.FStar_Parser_AST.level) end) in ( @@ -1622,11 +1623,11 @@ let ds_non_rec = (fun pat t1 t2 -> ( let t1 = (desugar_exp env t1) in ( -let _62_1436 = (desugar_binding_pat_maybe_top top_level env pat) -in (match (_62_1436) with +let _62_1445 = (desugar_binding_pat_maybe_top top_level env pat) +in (match (_62_1445) with | (env, binder, pat) -> begin (match (binder) with -| TBinder (_62_1438) -> begin +| TBinder (_62_1447) -> begin (FStar_All.failwith "Unexpected type binder in let") end | LetBinder (l, t) -> begin @@ -1635,7 +1636,7 @@ end let body = (desugar_exp env t2) in (FStar_All.pipe_left pos (FStar_Absyn_Syntax.mk_Exp_let ((((false), (({FStar_Absyn_Syntax.lbname = FStar_Util.Inr (l); FStar_Absyn_Syntax.lbtyp = t; FStar_Absyn_Syntax.lbeff = FStar_Absyn_Const.effect_ALL_lid; FStar_Absyn_Syntax.lbdef = t1})::[]))), (body))))) end -| VBinder (x, t, _62_1448) -> begin +| VBinder (x, t, _62_1457) -> begin ( let body = (desugar_exp env t2) @@ -1646,9 +1647,9 @@ let body = (match (pat) with body end | Some (pat) -> begin -(let _157_484 = (let _157_483 = (FStar_Absyn_Util.bvd_to_exp x t) -in ((_157_483), ((((pat), (None), (body)))::[]))) -in (FStar_Absyn_Syntax.mk_Exp_match _157_484 None body.FStar_Absyn_Syntax.pos)) +(let _157_495 = (let _157_494 = (FStar_Absyn_Util.bvd_to_exp x t) +in ((_157_494), ((((pat), (None), (body)))::[]))) +in (FStar_Absyn_Syntax.mk_Exp_match _157_495 None body.FStar_Absyn_Syntax.pos)) end) in (FStar_All.pipe_left pos (FStar_Absyn_Syntax.mk_Exp_let ((((false), (((mk_lb ((FStar_Util.Inl (x)), (t), (t1))))::[]))), (body)))))) end) @@ -1660,16 +1661,16 @@ end else begin end))) end | FStar_Parser_AST.If (t1, t2, t3) -> begin -(let _157_497 = (let _157_496 = (let _157_495 = (desugar_exp env t1) -in (let _157_494 = (let _157_493 = (let _157_489 = (desugar_exp env t2) -in (((FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_constant (FStar_Const.Const_bool (true))) None t2.FStar_Parser_AST.range)), (None), (_157_489))) -in (let _157_492 = (let _157_491 = (let _157_490 = (desugar_exp env t3) -in (((FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_constant (FStar_Const.Const_bool (false))) None t3.FStar_Parser_AST.range)), (None), (_157_490))) -in (_157_491)::[]) -in (_157_493)::_157_492)) -in ((_157_495), (_157_494)))) -in (FStar_Absyn_Syntax.mk_Exp_match _157_496)) -in (FStar_All.pipe_left pos _157_497)) +(let _157_508 = (let _157_507 = (let _157_506 = (desugar_exp env t1) +in (let _157_505 = (let _157_504 = (let _157_500 = (desugar_exp env t2) +in (((FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_constant (FStar_Const.Const_bool (true))) None t2.FStar_Parser_AST.range)), (None), (_157_500))) +in (let _157_503 = (let _157_502 = (let _157_501 = (desugar_exp env t3) +in (((FStar_Absyn_Util.withinfo (FStar_Absyn_Syntax.Pat_constant (FStar_Const.Const_bool (false))) None t3.FStar_Parser_AST.range)), (None), (_157_501))) +in (_157_502)::[]) +in (_157_504)::_157_503)) +in ((_157_506), (_157_505)))) +in (FStar_Absyn_Syntax.mk_Exp_match _157_507)) +in (FStar_All.pipe_left pos _157_508)) end | FStar_Parser_AST.TryWith (e, branches) -> begin ( @@ -1692,12 +1693,12 @@ end | FStar_Parser_AST.Match (e, branches) -> begin ( -let desugar_branch = (fun _62_1487 -> (match (_62_1487) with +let desugar_branch = (fun _62_1496 -> (match (_62_1496) with | (pat, wopt, b) -> begin ( -let _62_1490 = (desugar_match_pat env pat) -in (match (_62_1490) with +let _62_1499 = (desugar_match_pat env pat) +in (match (_62_1499) with | (env, pat) -> begin ( @@ -1706,8 +1707,8 @@ let wopt = (match (wopt) with None end | Some (e) -> begin -(let _157_500 = (desugar_exp env e) -in Some (_157_500)) +(let _157_511 = (desugar_exp env e) +in Some (_157_511)) end) in ( @@ -1715,36 +1716,36 @@ let b = (desugar_exp env b) in ((pat), (wopt), (b)))) end)) end)) -in (let _157_506 = (let _157_505 = (let _157_504 = (desugar_exp env e) -in (let _157_503 = (FStar_List.map desugar_branch branches) -in ((_157_504), (_157_503)))) -in (FStar_Absyn_Syntax.mk_Exp_match _157_505)) -in (FStar_All.pipe_left pos _157_506))) +in (let _157_517 = (let _157_516 = (let _157_515 = (desugar_exp env e) +in (let _157_514 = (FStar_List.map desugar_branch branches) +in ((_157_515), (_157_514)))) +in (FStar_Absyn_Syntax.mk_Exp_match _157_516)) +in (FStar_All.pipe_left pos _157_517))) end | FStar_Parser_AST.Ascribed (e, t) -> begin -(let _157_512 = (let _157_511 = (let _157_510 = (desugar_exp env e) -in (let _157_509 = (desugar_typ env t) -in ((_157_510), (_157_509), (None)))) -in (FStar_Absyn_Syntax.mk_Exp_ascribed _157_511)) -in (FStar_All.pipe_left pos _157_512)) +(let _157_523 = (let _157_522 = (let _157_521 = (desugar_exp env e) +in (let _157_520 = (desugar_typ env t) +in ((_157_521), (_157_520), (None)))) +in (FStar_Absyn_Syntax.mk_Exp_ascribed _157_522)) +in (FStar_All.pipe_left pos _157_523)) end -| FStar_Parser_AST.Record (_62_1501, []) -> begin +| FStar_Parser_AST.Record (_62_1510, []) -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected empty record"), (top.FStar_Parser_AST.range))))) end | FStar_Parser_AST.Record (eopt, fields) -> begin ( -let _62_1512 = (FStar_List.hd fields) -in (match (_62_1512) with -| (f, _62_1511) -> begin +let _62_1521 = (FStar_List.hd fields) +in (match (_62_1521) with +| (f, _62_1520) -> begin ( let qfn = (fun g -> (FStar_Ident.lid_of_ids (FStar_List.append f.FStar_Ident.ns ((g)::[])))) in ( -let _62_1518 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_record_by_field_name env) f) -in (match (_62_1518) with -| (record, _62_1517) -> begin +let _62_1527 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_record_by_field_name env) f) +in (match (_62_1527) with +| (record, _62_1526) -> begin ( let get_field = (fun xopt f -> ( @@ -1752,43 +1753,43 @@ let get_field = (fun xopt f -> ( let fn = f.FStar_Ident.ident in ( -let found = (FStar_All.pipe_right fields (FStar_Util.find_opt (fun _62_1526 -> (match (_62_1526) with -| (g, _62_1525) -> begin +let found = (FStar_All.pipe_right fields (FStar_Util.find_opt (fun _62_1535 -> (match (_62_1535) with +| (g, _62_1534) -> begin ( let gn = g.FStar_Ident.ident in (fn.FStar_Ident.idText = gn.FStar_Ident.idText)) end)))) in (match (found) with -| Some (_62_1530, e) -> begin -(let _157_520 = (qfn fn) -in ((_157_520), (e))) +| Some (_62_1539, e) -> begin +(let _157_531 = (qfn fn) +in ((_157_531), (e))) end | None -> begin (match (xopt) with | None -> begin -(let _157_523 = (let _157_522 = (let _157_521 = (FStar_Util.format1 "Field %s is missing" (FStar_Ident.text_of_lid f)) -in ((_157_521), (top.FStar_Parser_AST.range))) -in FStar_Absyn_Syntax.Error (_157_522)) -in (Prims.raise _157_523)) +(let _157_534 = (let _157_533 = (let _157_532 = (FStar_Util.format1 "Field %s is missing" (FStar_Ident.text_of_lid f)) +in ((_157_532), (top.FStar_Parser_AST.range))) +in FStar_Absyn_Syntax.Error (_157_533)) +in (Prims.raise _157_534)) end | Some (x) -> begin -(let _157_524 = (qfn fn) -in ((_157_524), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Project (((x), (f)))) x.FStar_Parser_AST.range x.FStar_Parser_AST.level)))) +(let _157_535 = (qfn fn) +in ((_157_535), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Project (((x), (f)))) x.FStar_Parser_AST.range x.FStar_Parser_AST.level)))) end) end)))) in ( let recterm = (match (eopt) with | None -> begin -(let _157_529 = (let _157_528 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1542 -> (match (_62_1542) with -| (f, _62_1541) -> begin -(let _157_527 = (let _157_526 = (get_field None f) -in (FStar_All.pipe_left Prims.snd _157_526)) -in ((_157_527), (FStar_Parser_AST.Nothing))) +(let _157_540 = (let _157_539 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1551 -> (match (_62_1551) with +| (f, _62_1550) -> begin +(let _157_538 = (let _157_537 = (get_field None f) +in (FStar_All.pipe_left Prims.snd _157_537)) +in ((_157_538), (FStar_Parser_AST.Nothing))) end)))) -in ((record.FStar_Parser_DesugarEnv.constrname), (_157_528))) -in FStar_Parser_AST.Construct (_157_529)) +in ((record.FStar_Parser_DesugarEnv.constrname), (_157_539))) +in FStar_Parser_AST.Construct (_157_540)) end | Some (e) -> begin ( @@ -1796,17 +1797,17 @@ end let x = (FStar_Absyn_Util.genident (Some (e.FStar_Parser_AST.range))) in ( -let xterm = (let _157_531 = (let _157_530 = (FStar_Ident.lid_of_ids ((x)::[])) -in FStar_Parser_AST.Var (_157_530)) -in (FStar_Parser_AST.mk_term _157_531 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) +let xterm = (let _157_542 = (let _157_541 = (FStar_Ident.lid_of_ids ((x)::[])) +in FStar_Parser_AST.Var (_157_541)) +in (FStar_Parser_AST.mk_term _157_542 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) in ( -let record = (let _157_534 = (let _157_533 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1550 -> (match (_62_1550) with -| (f, _62_1549) -> begin +let record = (let _157_545 = (let _157_544 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map (fun _62_1559 -> (match (_62_1559) with +| (f, _62_1558) -> begin (get_field (Some (xterm)) f) end)))) -in ((None), (_157_533))) -in FStar_Parser_AST.Record (_157_534)) +in ((None), (_157_544))) +in FStar_Parser_AST.Record (_157_545)) in FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatVar (((x), (None)))) x.FStar_Ident.idRange)), (e)))::[]), ((FStar_Parser_AST.mk_term record top.FStar_Parser_AST.range top.FStar_Parser_AST.level))))))) end) in ( @@ -1816,21 +1817,21 @@ in ( let e = (desugar_exp env recterm) in (match (e.FStar_Absyn_Syntax.n) with -| FStar_Absyn_Syntax.Exp_meta (FStar_Absyn_Syntax.Meta_desugared ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Exp_app ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Exp_fvar (fv, _62_1573); FStar_Absyn_Syntax.tk = _62_1570; FStar_Absyn_Syntax.pos = _62_1568; FStar_Absyn_Syntax.fvs = _62_1566; FStar_Absyn_Syntax.uvs = _62_1564}, args); FStar_Absyn_Syntax.tk = _62_1562; FStar_Absyn_Syntax.pos = _62_1560; FStar_Absyn_Syntax.fvs = _62_1558; FStar_Absyn_Syntax.uvs = _62_1556}, FStar_Absyn_Syntax.Data_app)) -> begin -( - -let e = (let _157_544 = (let _157_543 = (let _157_542 = (let _157_541 = (let _157_540 = (let _157_539 = (let _157_538 = (let _157_537 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map Prims.fst)) -in ((record.FStar_Parser_DesugarEnv.typename), (_157_537))) -in FStar_Absyn_Syntax.Record_ctor (_157_538)) -in Some (_157_539)) -in ((fv), (_157_540))) -in (FStar_Absyn_Syntax.mk_Exp_fvar _157_541 None e.FStar_Absyn_Syntax.pos)) -in ((_157_542), (args))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_543)) -in (FStar_All.pipe_left pos _157_544)) +| FStar_Absyn_Syntax.Exp_meta (FStar_Absyn_Syntax.Meta_desugared ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Exp_app ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Exp_fvar (fv, _62_1582); FStar_Absyn_Syntax.tk = _62_1579; FStar_Absyn_Syntax.pos = _62_1577; FStar_Absyn_Syntax.fvs = _62_1575; FStar_Absyn_Syntax.uvs = _62_1573}, args); FStar_Absyn_Syntax.tk = _62_1571; FStar_Absyn_Syntax.pos = _62_1569; FStar_Absyn_Syntax.fvs = _62_1567; FStar_Absyn_Syntax.uvs = _62_1565}, FStar_Absyn_Syntax.Data_app)) -> begin +( + +let e = (let _157_555 = (let _157_554 = (let _157_553 = (let _157_552 = (let _157_551 = (let _157_550 = (let _157_549 = (let _157_548 = (FStar_All.pipe_right record.FStar_Parser_DesugarEnv.fields (FStar_List.map Prims.fst)) +in ((record.FStar_Parser_DesugarEnv.typename), (_157_548))) +in FStar_Absyn_Syntax.Record_ctor (_157_549)) +in Some (_157_550)) +in ((fv), (_157_551))) +in (FStar_Absyn_Syntax.mk_Exp_fvar _157_552 None e.FStar_Absyn_Syntax.pos)) +in ((_157_553), (args))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_554)) +in (FStar_All.pipe_left pos _157_555)) in (FStar_Absyn_Syntax.mk_Exp_meta (FStar_Absyn_Syntax.Meta_desugared (((e), (FStar_Absyn_Syntax.Data_app)))))) end -| _62_1587 -> begin +| _62_1596 -> begin e end))))) end))) @@ -1839,8 +1840,8 @@ end | FStar_Parser_AST.Project (e, f) -> begin ( -let _62_1594 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_projector_by_field_name env) f) -in (match (_62_1594) with +let _62_1603 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_projector_by_field_name env) f) +in (match (_62_1603) with | (fieldname, is_rec) -> begin ( @@ -1849,9 +1850,9 @@ in ( let fn = ( -let _62_1599 = (FStar_Util.prefix fieldname.FStar_Ident.ns) -in (match (_62_1599) with -| (ns, _62_1598) -> begin +let _62_1608 = (FStar_Util.prefix fieldname.FStar_Ident.ns) +in (match (_62_1608) with +| (ns, _62_1607) -> begin (FStar_Ident.lid_of_ids (FStar_List.append ns ((f.FStar_Ident.ident)::[]))) end)) in ( @@ -1861,18 +1862,30 @@ Some (FStar_Absyn_Syntax.Record_projector (fn)) end else begin None end -in (let _157_551 = (let _157_550 = (let _157_549 = (FStar_Absyn_Util.fvar qual fieldname (FStar_Ident.range_of_lid f)) -in (let _157_548 = (let _157_547 = (FStar_Absyn_Syntax.varg e) -in (_157_547)::[]) -in ((_157_549), (_157_548)))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_550)) -in (FStar_All.pipe_left pos _157_551))))) +in (let _157_562 = (let _157_561 = (let _157_560 = (FStar_Absyn_Util.fvar qual fieldname (FStar_Ident.range_of_lid f)) +in (let _157_559 = (let _157_558 = (FStar_Absyn_Syntax.varg e) +in (_157_558)::[]) +in ((_157_560), (_157_559)))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_561)) +in (FStar_All.pipe_left pos _157_562))))) end)) end | FStar_Parser_AST.Paren (e) -> begin (desugar_exp env e) end -| _62_1605 -> begin +| FStar_Parser_AST.Projector (ns, id) -> begin +( + +let l = (FStar_Parser_DesugarEnv.qual ns id) +in (desugar_name setpos env l)) +end +| FStar_Parser_AST.Discrim (lid) -> begin +( + +let lid' = (FStar_Absyn_Util.mk_discriminator lid) +in (desugar_name setpos env lid')) +end +| _62_1622 -> begin (FStar_Parser_AST.error "Unexpected term" top top.FStar_Parser_AST.range) end)))) and desugar_typ : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.typ = (fun env top -> ( @@ -1882,8 +1895,8 @@ in ( let setpos = (fun t -> ( -let _62_1612 = t -in {FStar_Absyn_Syntax.n = _62_1612.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1612.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = top.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1612.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1612.FStar_Absyn_Syntax.uvs})) +let _62_1629 = t +in {FStar_Absyn_Syntax.n = _62_1629.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1629.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = top.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1629.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1629.FStar_Absyn_Syntax.uvs})) in ( let top = (unparen top) @@ -1891,15 +1904,15 @@ in ( let head_and_args = (fun t -> ( -let rec aux = (fun args t -> (match ((let _157_574 = (unparen t) -in _157_574.FStar_Parser_AST.tm)) with +let rec aux = (fun args t -> (match ((let _157_585 = (unparen t) +in _157_585.FStar_Parser_AST.tm)) with | FStar_Parser_AST.App (t, arg, imp) -> begin (aux ((((arg), (imp)))::args) t) end | FStar_Parser_AST.Construct (l, args') -> begin (({FStar_Parser_AST.tm = FStar_Parser_AST.Name (l); FStar_Parser_AST.range = t.FStar_Parser_AST.range; FStar_Parser_AST.level = t.FStar_Parser_AST.level}), ((FStar_List.append args' args))) end -| _62_1630 -> begin +| _62_1647 -> begin ((t), (args)) end)) in (aux [] t))) @@ -1914,8 +1927,8 @@ let t = (label_conjuncts "pre-condition" true lopt t) in if (is_type env t) then begin (desugar_typ env t) end else begin -(let _157_575 = (desugar_exp env t) -in (FStar_All.pipe_right _157_575 FStar_Absyn_Util.b2t)) +(let _157_586 = (desugar_exp env t) +in (FStar_All.pipe_right _157_586 FStar_Absyn_Util.b2t)) end) end | FStar_Parser_AST.Ensures (t, lopt) -> begin @@ -1925,38 +1938,38 @@ let t = (label_conjuncts "post-condition" false lopt t) in if (is_type env t) then begin (desugar_typ env t) end else begin -(let _157_576 = (desugar_exp env t) -in (FStar_All.pipe_right _157_576 FStar_Absyn_Util.b2t)) +(let _157_587 = (desugar_exp env t) +in (FStar_All.pipe_right _157_587 FStar_Absyn_Util.b2t)) end) end -| FStar_Parser_AST.Op ("*", (t1)::(_62_1644)::[]) -> begin +| FStar_Parser_AST.Op ("*", (t1)::(_62_1661)::[]) -> begin if (is_type env t1) then begin ( let rec flatten = (fun t -> (match (t.FStar_Parser_AST.tm) with | FStar_Parser_AST.Op ("*", (t1)::(t2)::[]) -> begin -(let _157_579 = (flatten t1) -in (FStar_List.append _157_579 ((t2)::[]))) +(let _157_590 = (flatten t1) +in (FStar_List.append _157_590 ((t2)::[]))) end -| _62_1658 -> begin +| _62_1675 -> begin (t)::[] end)) in ( -let targs = (let _157_582 = (flatten top) -in (FStar_All.pipe_right _157_582 (FStar_List.map (fun t -> (let _157_581 = (desugar_typ env t) -in (FStar_Absyn_Syntax.targ _157_581)))))) +let targs = (let _157_593 = (flatten top) +in (FStar_All.pipe_right _157_593 (FStar_List.map (fun t -> (let _157_592 = (desugar_typ env t) +in (FStar_Absyn_Syntax.targ _157_592)))))) in ( -let tup = (let _157_583 = (FStar_Absyn_Util.mk_tuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) -in (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) _157_583)) +let tup = (let _157_594 = (FStar_Absyn_Util.mk_tuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) +in (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) _157_594)) in (FStar_All.pipe_left wpos (FStar_Absyn_Syntax.mk_Typ_app ((tup), (targs))))))) end else begin -(let _157_589 = (let _157_588 = (let _157_587 = (let _157_586 = (FStar_Parser_AST.term_to_string t1) -in (FStar_Util.format1 "The operator \"*\" is resolved here as multiplication since \"%s\" is a term, although a type was expected" _157_586)) -in ((_157_587), (top.FStar_Parser_AST.range))) -in FStar_Absyn_Syntax.Error (_157_588)) -in (Prims.raise _157_589)) +(let _157_600 = (let _157_599 = (let _157_598 = (let _157_597 = (FStar_Parser_AST.term_to_string t1) +in (FStar_Util.format1 "The operator \"*\" is resolved here as multiplication since \"%s\" is a term, although a type was expected" _157_597)) +in ((_157_598), (top.FStar_Parser_AST.range))) +in FStar_Absyn_Syntax.Error (_157_599)) +in (Prims.raise _157_600)) end end | FStar_Parser_AST.Op ("=!=", args) -> begin @@ -1965,21 +1978,21 @@ end | FStar_Parser_AST.Op (s, args) -> begin (match ((op_as_tylid env (FStar_List.length args) top.FStar_Parser_AST.range s)) with | None -> begin -(let _157_590 = (desugar_exp env top) -in (FStar_All.pipe_right _157_590 FStar_Absyn_Util.b2t)) +(let _157_601 = (desugar_exp env top) +in (FStar_All.pipe_right _157_601 FStar_Absyn_Util.b2t)) end | Some (l) -> begin ( -let args = (FStar_List.map (fun t -> (let _157_592 = (desugar_typ_or_exp env t) -in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_592))) args) -in (let _157_593 = (FStar_Absyn_Util.ftv l FStar_Absyn_Syntax.kun) -in (FStar_Absyn_Util.mk_typ_app _157_593 args))) +let args = (FStar_List.map (fun t -> (let _157_603 = (desugar_typ_or_exp env t) +in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_603))) args) +in (let _157_604 = (FStar_Absyn_Util.ftv l FStar_Absyn_Syntax.kun) +in (FStar_Absyn_Util.mk_typ_app _157_604 args))) end) end | FStar_Parser_AST.Tvar (a) -> begin -(let _157_594 = (FStar_Parser_DesugarEnv.fail_or2 (FStar_Parser_DesugarEnv.try_lookup_typ_var env) a) -in (FStar_All.pipe_left setpos _157_594)) +(let _157_605 = (FStar_Parser_DesugarEnv.fail_or2 (FStar_Parser_DesugarEnv.try_lookup_typ_var env) a) +in (FStar_All.pipe_left setpos _157_605)) end | (FStar_Parser_AST.Var (l)) | (FStar_Parser_AST.Name (l)) when ((FStar_List.length l.FStar_Ident.ns) = (Prims.parse_int "0")) -> begin (match ((FStar_Parser_DesugarEnv.try_lookup_typ_var env l.FStar_Ident.ident)) with @@ -1987,28 +2000,28 @@ end (setpos t) end | None -> begin -(let _157_595 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) -in (FStar_All.pipe_left setpos _157_595)) +(let _157_606 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) +in (FStar_All.pipe_left setpos _157_606)) end) end | (FStar_Parser_AST.Var (l)) | (FStar_Parser_AST.Name (l)) -> begin ( let l = (FStar_Absyn_Util.set_lid_range l top.FStar_Parser_AST.range) -in (let _157_596 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) -in (FStar_All.pipe_left setpos _157_596))) +in (let _157_607 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) +in (FStar_All.pipe_left setpos _157_607))) end | FStar_Parser_AST.Construct (l, args) -> begin ( -let t = (let _157_597 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) -in (FStar_All.pipe_left setpos _157_597)) +let t = (let _157_608 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) l) +in (FStar_All.pipe_left setpos _157_608)) in ( -let args = (FStar_List.map (fun _62_1694 -> (match (_62_1694) with +let args = (FStar_List.map (fun _62_1711 -> (match (_62_1711) with | (t, imp) -> begin -(let _157_599 = (desugar_typ_or_exp env t) -in (FStar_All.pipe_left (arg_withimp_t imp) _157_599)) +(let _157_610 = (desugar_typ_or_exp env t) +in (FStar_All.pipe_left (arg_withimp_t imp) _157_610)) end)) args) in (FStar_Absyn_Util.mk_typ_app t args))) end @@ -2025,16 +2038,16 @@ end | (hd)::tl -> begin ( -let _62_1712 = (desugar_binding_pat env hd) -in (match (_62_1712) with +let _62_1729 = (desugar_binding_pat env hd) +in (match (_62_1729) with | (env, bnd, pat) -> begin (match (pat) with | Some (q) -> begin -(let _157_611 = (let _157_610 = (let _157_609 = (let _157_608 = (FStar_Absyn_Print.pat_to_string q) -in (FStar_Util.format1 "Pattern matching at the type level is not supported; got %s\n" _157_608)) -in ((_157_609), (hd.FStar_Parser_AST.prange))) -in FStar_Absyn_Syntax.Error (_157_610)) -in (Prims.raise _157_611)) +(let _157_622 = (let _157_621 = (let _157_620 = (let _157_619 = (FStar_Absyn_Print.pat_to_string q) +in (FStar_Util.format1 "Pattern matching at the type level is not supported; got %s\n" _157_619)) +in ((_157_620), (hd.FStar_Parser_AST.prange))) +in FStar_Absyn_Syntax.Error (_157_621)) +in (Prims.raise _157_622)) end | None -> begin ( @@ -2046,19 +2059,19 @@ end)) end)) in (aux env [] binders)) end -| FStar_Parser_AST.App (_62_1718) -> begin +| FStar_Parser_AST.App (_62_1735) -> begin ( -let rec aux = (fun args e -> (match ((let _157_616 = (unparen e) -in _157_616.FStar_Parser_AST.tm)) with +let rec aux = (fun args e -> (match ((let _157_627 = (unparen e) +in _157_627.FStar_Parser_AST.tm)) with | FStar_Parser_AST.App (e, arg, imp) -> begin ( -let arg = (let _157_617 = (desugar_typ_or_exp env arg) -in (FStar_All.pipe_left (arg_withimp_t imp) _157_617)) +let arg = (let _157_628 = (desugar_typ_or_exp env arg) +in (FStar_All.pipe_left (arg_withimp_t imp) _157_628)) in (aux ((arg)::args) e)) end -| _62_1730 -> begin +| _62_1747 -> begin ( let head = (desugar_typ env e) @@ -2072,8 +2085,8 @@ end | FStar_Parser_AST.Product (binders, t) -> begin ( -let _62_1742 = (uncurry binders t) -in (match (_62_1742) with +let _62_1759 = (uncurry binders t) +in (match (_62_1759) with | (bs, t) -> begin ( @@ -2093,8 +2106,8 @@ in ( let bb = (desugar_binder mlenv hd) in ( -let _62_1756 = (as_binder env hd.FStar_Parser_AST.aqual bb) -in (match (_62_1756) with +let _62_1773 = (as_binder env hd.FStar_Parser_AST.aqual bb) +in (match (_62_1773) with | (b, env) -> begin (aux env ((b)::bs) tl) end)))) @@ -2104,28 +2117,28 @@ end)) end | FStar_Parser_AST.Refine (b, f) -> begin (match ((desugar_exp_binder env b)) with -| (None, _62_1763) -> begin +| (None, _62_1780) -> begin (FStar_All.failwith "Missing binder in refinement") end | b -> begin ( -let _62_1777 = (match ((as_binder env None (FStar_Util.Inr (b)))) with -| ((FStar_Util.Inr (x), _62_1769), env) -> begin +let _62_1794 = (match ((as_binder env None (FStar_Util.Inr (b)))) with +| ((FStar_Util.Inr (x), _62_1786), env) -> begin ((x), (env)) end -| _62_1774 -> begin +| _62_1791 -> begin (FStar_All.failwith "impossible") end) -in (match (_62_1777) with +in (match (_62_1794) with | (b, env) -> begin ( let f = if (is_type env f) then begin (desugar_formula env f) end else begin -(let _157_628 = (desugar_exp env f) -in (FStar_All.pipe_right _157_628 FStar_Absyn_Util.b2t)) +(let _157_639 = (desugar_exp env f) +in (FStar_All.pipe_right _157_639 FStar_Absyn_Util.b2t)) end in (FStar_All.pipe_left wpos (FStar_Absyn_Syntax.mk_Typ_refine ((b), (f))))) end)) @@ -2135,52 +2148,52 @@ end (desugar_typ env t) end | FStar_Parser_AST.Ascribed (t, k) -> begin -(let _157_636 = (let _157_635 = (let _157_634 = (desugar_typ env t) -in (let _157_633 = (desugar_kind env k) -in ((_157_634), (_157_633)))) -in (FStar_Absyn_Syntax.mk_Typ_ascribed' _157_635)) -in (FStar_All.pipe_left wpos _157_636)) +(let _157_647 = (let _157_646 = (let _157_645 = (desugar_typ env t) +in (let _157_644 = (desugar_kind env k) +in ((_157_645), (_157_644)))) +in (FStar_Absyn_Syntax.mk_Typ_ascribed' _157_646)) +in (FStar_All.pipe_left wpos _157_647)) end | FStar_Parser_AST.Sum (binders, t) -> begin ( -let _62_1811 = (FStar_List.fold_left (fun _62_1796 b -> (match (_62_1796) with +let _62_1828 = (FStar_List.fold_left (fun _62_1813 b -> (match (_62_1813) with | (env, tparams, typs) -> begin ( -let _62_1800 = (desugar_exp_binder env b) -in (match (_62_1800) with +let _62_1817 = (desugar_exp_binder env b) +in (match (_62_1817) with | (xopt, t) -> begin ( -let _62_1806 = (match (xopt) with +let _62_1823 = (match (xopt) with | None -> begin -(let _157_639 = (FStar_Absyn_Util.new_bvd (Some (top.FStar_Parser_AST.range))) -in ((env), (_157_639))) +(let _157_650 = (FStar_Absyn_Util.new_bvd (Some (top.FStar_Parser_AST.range))) +in ((env), (_157_650))) end | Some (x) -> begin (FStar_Parser_DesugarEnv.push_local_vbinding env x) end) -in (match (_62_1806) with +in (match (_62_1823) with | (env, x) -> begin -(let _157_643 = (let _157_642 = (let _157_641 = (let _157_640 = (FStar_Absyn_Util.close_with_lam tparams t) -in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_640)) -in (_157_641)::[]) -in (FStar_List.append typs _157_642)) -in ((env), ((FStar_List.append tparams ((((FStar_Util.Inr ((FStar_Absyn_Util.bvd_to_bvar_s x t))), (None)))::[]))), (_157_643))) +(let _157_654 = (let _157_653 = (let _157_652 = (let _157_651 = (FStar_Absyn_Util.close_with_lam tparams t) +in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_651)) +in (_157_652)::[]) +in (FStar_List.append typs _157_653)) +in ((env), ((FStar_List.append tparams ((((FStar_Util.Inr ((FStar_Absyn_Util.bvd_to_bvar_s x t))), (None)))::[]))), (_157_654))) end)) end)) end)) ((env), ([]), ([])) (FStar_List.append binders (((FStar_Parser_AST.mk_binder (FStar_Parser_AST.NoName (t)) t.FStar_Parser_AST.range FStar_Parser_AST.Type None))::[]))) -in (match (_62_1811) with -| (env, _62_1809, targs) -> begin +in (match (_62_1828) with +| (env, _62_1826, targs) -> begin ( -let tup = (let _157_644 = (FStar_Absyn_Util.mk_dtuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) -in (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) _157_644)) +let tup = (let _157_655 = (FStar_Absyn_Util.mk_dtuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) +in (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) _157_655)) in (FStar_All.pipe_left wpos (FStar_Absyn_Syntax.mk_Typ_app ((tup), (targs))))) end)) end -| FStar_Parser_AST.Record (_62_1814) -> begin +| FStar_Parser_AST.Record (_62_1831) -> begin (FStar_All.failwith "Unexpected record type") end | FStar_Parser_AST.Let (FStar_Parser_AST.NoLetQualifier, ((x, v))::[], t) -> begin @@ -2195,10 +2208,10 @@ end | (FStar_Parser_AST.If (_)) | (FStar_Parser_AST.Labeled (_)) -> begin (desugar_formula env top) end -| _62_1833 when (top.FStar_Parser_AST.level = FStar_Parser_AST.Formula) -> begin +| _62_1850 when (top.FStar_Parser_AST.level = FStar_Parser_AST.Formula) -> begin (desugar_formula env top) end -| _62_1835 -> begin +| _62_1852 -> begin (FStar_Parser_AST.error "Expected a type" top top.FStar_Parser_AST.range) end)))))) and desugar_comp : FStar_Range.range -> Prims.bool -> FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.comp = (fun r default_ok env t -> ( @@ -2208,8 +2221,8 @@ in ( let pre_process_comp_typ = (fun t -> ( -let _62_1846 = (head_and_args t) -in (match (_62_1846) with +let _62_1863 = (head_and_args t) +in (match (_62_1863) with | (head, args) -> begin (match (head.FStar_Parser_AST.tm) with | FStar_Parser_AST.Name (lemma) when (lemma.FStar_Ident.ident.FStar_Ident.idText = "Lemma") -> begin @@ -2221,18 +2234,18 @@ in ( let nil_pat = (((FStar_Parser_AST.mk_term (FStar_Parser_AST.Name (FStar_Absyn_Const.nil_lid)) t.FStar_Parser_AST.range FStar_Parser_AST.Expr)), (FStar_Parser_AST.Nothing)) in ( -let _62_1872 = (FStar_All.pipe_right args (FStar_List.partition (fun _62_1854 -> (match (_62_1854) with -| (arg, _62_1853) -> begin -(match ((let _157_656 = (unparen arg) -in _157_656.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (d); FStar_Parser_AST.range = _62_1858; FStar_Parser_AST.level = _62_1856}, _62_1863, _62_1865) -> begin +let _62_1889 = (FStar_All.pipe_right args (FStar_List.partition (fun _62_1871 -> (match (_62_1871) with +| (arg, _62_1870) -> begin +(match ((let _157_667 = (unparen arg) +in _157_667.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (d); FStar_Parser_AST.range = _62_1875; FStar_Parser_AST.level = _62_1873}, _62_1880, _62_1882) -> begin (d.FStar_Ident.ident.FStar_Ident.idText = "decreases") end -| _62_1869 -> begin +| _62_1886 -> begin false end) end)))) -in (match (_62_1872) with +in (match (_62_1889) with | (decreases_clause, args) -> begin ( @@ -2258,19 +2271,19 @@ let t = (FStar_Parser_AST.mk_term (FStar_Parser_AST.Construct (((lemma), ((FStar in (desugar_typ env t))) end)))) end -| FStar_Parser_AST.Name (tot) when (((tot.FStar_Ident.ident.FStar_Ident.idText = "Tot") && (not ((FStar_Parser_DesugarEnv.is_effect_name env FStar_Absyn_Const.effect_Tot_lid)))) && (let _157_657 = (FStar_Parser_DesugarEnv.current_module env) -in (FStar_Ident.lid_equals _157_657 FStar_Absyn_Const.prims_lid))) -> begin +| FStar_Parser_AST.Name (tot) when (((tot.FStar_Ident.ident.FStar_Ident.idText = "Tot") && (not ((FStar_Parser_DesugarEnv.is_effect_name env FStar_Absyn_Const.effect_Tot_lid)))) && (let _157_668 = (FStar_Parser_DesugarEnv.current_module env) +in (FStar_Ident.lid_equals _157_668 FStar_Absyn_Const.prims_lid))) -> begin ( -let args = (FStar_List.map (fun _62_1887 -> (match (_62_1887) with +let args = (FStar_List.map (fun _62_1904 -> (match (_62_1904) with | (t, imp) -> begin -(let _157_659 = (desugar_typ_or_exp env t) -in (FStar_All.pipe_left (arg_withimp_t imp) _157_659)) +(let _157_670 = (desugar_typ_or_exp env t) +in (FStar_All.pipe_left (arg_withimp_t imp) _157_670)) end)) args) -in (let _157_660 = (FStar_Absyn_Util.ftv FStar_Absyn_Const.effect_Tot_lid FStar_Absyn_Syntax.kun) -in (FStar_Absyn_Util.mk_typ_app _157_660 args))) +in (let _157_671 = (FStar_Absyn_Util.ftv FStar_Absyn_Const.effect_Tot_lid FStar_Absyn_Syntax.kun) +in (FStar_Absyn_Util.mk_typ_app _157_671 args))) end -| _62_1890 -> begin +| _62_1907 -> begin (desugar_typ env t) end) end))) @@ -2279,43 +2292,43 @@ in ( let t = (pre_process_comp_typ t) in ( -let _62_1894 = (FStar_Absyn_Util.head_and_args t) -in (match (_62_1894) with +let _62_1911 = (FStar_Absyn_Util.head_and_args t) +in (match (_62_1911) with | (head, args) -> begin -(match ((let _157_662 = (let _157_661 = (FStar_Absyn_Util.compress_typ head) -in _157_661.FStar_Absyn_Syntax.n) -in ((_157_662), (args)))) with -| (FStar_Absyn_Syntax.Typ_const (eff), ((FStar_Util.Inl (result_typ), _62_1901))::rest) -> begin +(match ((let _157_673 = (let _157_672 = (FStar_Absyn_Util.compress_typ head) +in _157_672.FStar_Absyn_Syntax.n) +in ((_157_673), (args)))) with +| (FStar_Absyn_Syntax.Typ_const (eff), ((FStar_Util.Inl (result_typ), _62_1918))::rest) -> begin ( -let _62_1941 = (FStar_All.pipe_right rest (FStar_List.partition (fun _62_11 -> (match (_62_11) with -| (FStar_Util.Inr (_62_1907), _62_1910) -> begin +let _62_1958 = (FStar_All.pipe_right rest (FStar_List.partition (fun _62_11 -> (match (_62_11) with +| (FStar_Util.Inr (_62_1924), _62_1927) -> begin false end -| (FStar_Util.Inl (t), _62_1915) -> begin +| (FStar_Util.Inl (t), _62_1932) -> begin (match (t.FStar_Absyn_Syntax.n) with -| FStar_Absyn_Syntax.Typ_app ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Typ_const (fv); FStar_Absyn_Syntax.tk = _62_1924; FStar_Absyn_Syntax.pos = _62_1922; FStar_Absyn_Syntax.fvs = _62_1920; FStar_Absyn_Syntax.uvs = _62_1918}, ((FStar_Util.Inr (_62_1929), _62_1932))::[]) -> begin +| FStar_Absyn_Syntax.Typ_app ({FStar_Absyn_Syntax.n = FStar_Absyn_Syntax.Typ_const (fv); FStar_Absyn_Syntax.tk = _62_1941; FStar_Absyn_Syntax.pos = _62_1939; FStar_Absyn_Syntax.fvs = _62_1937; FStar_Absyn_Syntax.uvs = _62_1935}, ((FStar_Util.Inr (_62_1946), _62_1949))::[]) -> begin (FStar_Ident.lid_equals fv.FStar_Absyn_Syntax.v FStar_Absyn_Const.decreases_lid) end -| _62_1938 -> begin +| _62_1955 -> begin false end) end)))) -in (match (_62_1941) with +in (match (_62_1958) with | (dec, rest) -> begin ( let decreases_clause = (FStar_All.pipe_right dec (FStar_List.map (fun _62_12 -> (match (_62_12) with -| (FStar_Util.Inl (t), _62_1946) -> begin +| (FStar_Util.Inl (t), _62_1963) -> begin (match (t.FStar_Absyn_Syntax.n) with -| FStar_Absyn_Syntax.Typ_app (_62_1949, ((FStar_Util.Inr (arg), _62_1953))::[]) -> begin +| FStar_Absyn_Syntax.Typ_app (_62_1966, ((FStar_Util.Inr (arg), _62_1970))::[]) -> begin FStar_Absyn_Syntax.DECREASES (arg) end -| _62_1959 -> begin +| _62_1976 -> begin (FStar_All.failwith "impos") end) end -| _62_1961 -> begin +| _62_1978 -> begin (FStar_All.failwith "impos") end)))) in if ((FStar_Parser_DesugarEnv.is_effect_name env eff.FStar_Absyn_Syntax.v) || (FStar_Ident.lid_equals eff.FStar_Absyn_Syntax.v FStar_Absyn_Const.effect_Tot_lid)) then begin @@ -2342,14 +2355,14 @@ in ( let rest = if (FStar_Ident.lid_equals eff.FStar_Absyn_Syntax.v FStar_Absyn_Const.effect_Lemma_lid) then begin (match (rest) with | (req)::(ens)::((FStar_Util.Inr (pat), aq))::[] -> begin -(let _157_669 = (let _157_668 = (let _157_667 = (let _157_666 = (let _157_665 = (FStar_Absyn_Syntax.mk_Exp_meta (FStar_Absyn_Syntax.Meta_desugared (((pat), (FStar_Absyn_Syntax.Meta_smt_pat))))) -in FStar_Util.Inr (_157_665)) -in ((_157_666), (aq))) -in (_157_667)::[]) -in (ens)::_157_668) -in (req)::_157_669) -end -| _62_1972 -> begin +(let _157_680 = (let _157_679 = (let _157_678 = (let _157_677 = (let _157_676 = (FStar_Absyn_Syntax.mk_Exp_meta (FStar_Absyn_Syntax.Meta_desugared (((pat), (FStar_Absyn_Syntax.Meta_smt_pat))))) +in FStar_Util.Inr (_157_676)) +in ((_157_677), (aq))) +in (_157_678)::[]) +in (ens)::_157_679) +in (req)::_157_680) +end +| _62_1989 -> begin rest end) end else begin @@ -2361,20 +2374,20 @@ end else begin if default_ok then begin (env.FStar_Parser_DesugarEnv.default_result_effect t r) end else begin -(let _157_671 = (let _157_670 = (FStar_Absyn_Print.typ_to_string t) -in (FStar_Util.format1 "%s is not an effect" _157_670)) -in (fail _157_671)) +(let _157_682 = (let _157_681 = (FStar_Absyn_Print.typ_to_string t) +in (FStar_Util.format1 "%s is not an effect" _157_681)) +in (fail _157_682)) end end) end)) end -| _62_1975 -> begin +| _62_1992 -> begin if default_ok then begin (env.FStar_Parser_DesugarEnv.default_result_effect t r) end else begin -(let _157_673 = (let _157_672 = (FStar_Absyn_Print.typ_to_string t) -in (FStar_Util.format1 "%s is not an effect" _157_672)) -in (fail _157_673)) +(let _157_684 = (let _157_683 = (FStar_Absyn_Print.typ_to_string t) +in (FStar_Util.format1 "%s is not an effect" _157_683)) +in (fail _157_684)) end end) end)))))) @@ -2385,25 +2398,25 @@ in ( let setpos = (fun kk -> ( -let _62_1982 = kk -in {FStar_Absyn_Syntax.n = _62_1982.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1982.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = k.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1982.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1982.FStar_Absyn_Syntax.uvs})) +let _62_1999 = kk +in {FStar_Absyn_Syntax.n = _62_1999.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_1999.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = k.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_1999.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_1999.FStar_Absyn_Syntax.uvs})) in ( let k = (unparen k) in (match (k.FStar_Parser_AST.tm) with -| FStar_Parser_AST.Name ({FStar_Ident.ns = _62_1991; FStar_Ident.ident = _62_1989; FStar_Ident.nsstr = _62_1987; FStar_Ident.str = "Type"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _62_2008; FStar_Ident.ident = _62_2006; FStar_Ident.nsstr = _62_2004; FStar_Ident.str = "Type"}) -> begin (setpos FStar_Absyn_Syntax.mk_Kind_type) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _62_2000; FStar_Ident.ident = _62_1998; FStar_Ident.nsstr = _62_1996; FStar_Ident.str = "Effect"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _62_2017; FStar_Ident.ident = _62_2015; FStar_Ident.nsstr = _62_2013; FStar_Ident.str = "Effect"}) -> begin (setpos FStar_Absyn_Syntax.mk_Kind_effect) end | FStar_Parser_AST.Name (l) -> begin -(match ((let _157_685 = (FStar_Parser_DesugarEnv.qualify_lid env l) -in (FStar_Parser_DesugarEnv.find_kind_abbrev env _157_685))) with +(match ((let _157_696 = (FStar_Parser_DesugarEnv.qualify_lid env l) +in (FStar_Parser_DesugarEnv.find_kind_abbrev env _157_696))) with | Some (l) -> begin (FStar_All.pipe_left pos (FStar_Absyn_Syntax.mk_Kind_abbrev ((((l), ([]))), (FStar_Absyn_Syntax.mk_Kind_unknown)))) end -| _62_2008 -> begin +| _62_2025 -> begin (FStar_Parser_AST.error "Unexpected term where kind was expected" k k.FStar_Parser_AST.range) end) end @@ -2413,25 +2426,25 @@ end | FStar_Parser_AST.Product (bs, k) -> begin ( -let _62_2016 = (uncurry bs k) -in (match (_62_2016) with +let _62_2033 = (uncurry bs k) +in (match (_62_2033) with | (bs, k) -> begin ( let rec aux = (fun env bs _62_13 -> (match (_62_13) with | [] -> begin -(let _157_696 = (let _157_695 = (let _157_694 = (desugar_kind env k) -in (((FStar_List.rev bs)), (_157_694))) -in (FStar_Absyn_Syntax.mk_Kind_arrow _157_695)) -in (FStar_All.pipe_left pos _157_696)) +(let _157_707 = (let _157_706 = (let _157_705 = (desugar_kind env k) +in (((FStar_List.rev bs)), (_157_705))) +in (FStar_Absyn_Syntax.mk_Kind_arrow _157_706)) +in (FStar_All.pipe_left pos _157_707)) end | (hd)::tl -> begin ( -let _62_2027 = (let _157_698 = (let _157_697 = (FStar_Parser_DesugarEnv.default_ml env) -in (desugar_binder _157_697 hd)) -in (FStar_All.pipe_right _157_698 (as_binder env hd.FStar_Parser_AST.aqual))) -in (match (_62_2027) with +let _62_2044 = (let _157_709 = (let _157_708 = (FStar_Parser_DesugarEnv.default_ml env) +in (desugar_binder _157_708 hd)) +in (FStar_All.pipe_right _157_709 (as_binder env hd.FStar_Parser_AST.aqual))) +in (match (_62_2044) with | (b, env) -> begin (aux env ((b)::bs) tl) end)) @@ -2447,7 +2460,7 @@ end | Some (l) -> begin ( -let args = (FStar_List.map (fun _62_2037 -> (match (_62_2037) with +let args = (FStar_List.map (fun _62_2054 -> (match (_62_2054) with | (t, b) -> begin ( @@ -2456,13 +2469,13 @@ Some (imp_tag) end else begin None end -in (let _157_700 = (desugar_typ_or_exp env t) -in ((_157_700), (qual)))) +in (let _157_711 = (desugar_typ_or_exp env t) +in ((_157_711), (qual)))) end)) args) in (FStar_All.pipe_left pos (FStar_Absyn_Syntax.mk_Kind_abbrev ((((l), (args))), (FStar_Absyn_Syntax.mk_Kind_unknown))))) end) end -| _62_2041 -> begin +| _62_2058 -> begin (FStar_Parser_AST.error "Unexpected term where kind was expected" k k.FStar_Parser_AST.range) end))))) and desugar_formula' : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.typ = (fun env f -> ( @@ -2483,7 +2496,7 @@ end | "~" -> begin Some (FStar_Absyn_Const.not_lid) end -| _62_2052 -> begin +| _62_2069 -> begin None end)) in ( @@ -2493,26 +2506,26 @@ in ( let setpos = (fun t -> ( -let _62_2057 = t -in {FStar_Absyn_Syntax.n = _62_2057.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_2057.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = f.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_2057.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_2057.FStar_Absyn_Syntax.uvs})) +let _62_2074 = t +in {FStar_Absyn_Syntax.n = _62_2074.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_2074.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = f.FStar_Parser_AST.range; FStar_Absyn_Syntax.fvs = _62_2074.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_2074.FStar_Absyn_Syntax.uvs})) in ( let desugar_quant = (fun q qt b pats body -> ( let tk = (desugar_binder env ( -let _62_2065 = b -in {FStar_Parser_AST.b = _62_2065.FStar_Parser_AST.b; FStar_Parser_AST.brange = _62_2065.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _62_2065.FStar_Parser_AST.aqual})) +let _62_2082 = b +in {FStar_Parser_AST.b = _62_2082.FStar_Parser_AST.b; FStar_Parser_AST.brange = _62_2082.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _62_2082.FStar_Parser_AST.aqual})) in ( -let desugar_pats = (fun env pats -> (FStar_List.map (fun es -> (FStar_All.pipe_right es (FStar_List.map (fun e -> (let _157_736 = (desugar_typ_or_exp env e) -in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_736)))))) pats)) +let desugar_pats = (fun env pats -> (FStar_List.map (fun es -> (FStar_All.pipe_right es (FStar_List.map (fun e -> (let _157_747 = (desugar_typ_or_exp env e) +in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_747)))))) pats)) in (match (tk) with | FStar_Util.Inl (Some (a), k) -> begin ( -let _62_2080 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (match (_62_2080) with +let _62_2097 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (match (_62_2097) with | (env, a) -> begin ( @@ -2526,29 +2539,29 @@ let body = (match (pats) with | [] -> begin body end -| _62_2085 -> begin -(let _157_737 = (FStar_Absyn_Syntax.mk_Typ_meta (FStar_Absyn_Syntax.Meta_pattern (((body), (pats))))) -in (FStar_All.pipe_left setpos _157_737)) +| _62_2102 -> begin +(let _157_748 = (FStar_Absyn_Syntax.mk_Typ_meta (FStar_Absyn_Syntax.Meta_pattern (((body), (pats))))) +in (FStar_All.pipe_left setpos _157_748)) end) in ( -let body = (let _157_743 = (let _157_742 = (let _157_741 = (let _157_740 = (FStar_Absyn_Syntax.t_binder (FStar_Absyn_Util.bvd_to_bvar_s a k)) -in (_157_740)::[]) -in ((_157_741), (body))) -in (FStar_Absyn_Syntax.mk_Typ_lam _157_742)) -in (FStar_All.pipe_left pos _157_743)) -in (let _157_747 = (let _157_746 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range qt b.FStar_Parser_AST.brange) FStar_Absyn_Syntax.kun) -in (let _157_745 = (let _157_744 = (FStar_Absyn_Syntax.targ body) -in (_157_744)::[]) -in (FStar_Absyn_Util.mk_typ_app _157_746 _157_745))) -in (FStar_All.pipe_left setpos _157_747)))))) +let body = (let _157_754 = (let _157_753 = (let _157_752 = (let _157_751 = (FStar_Absyn_Syntax.t_binder (FStar_Absyn_Util.bvd_to_bvar_s a k)) +in (_157_751)::[]) +in ((_157_752), (body))) +in (FStar_Absyn_Syntax.mk_Typ_lam _157_753)) +in (FStar_All.pipe_left pos _157_754)) +in (let _157_758 = (let _157_757 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range qt b.FStar_Parser_AST.brange) FStar_Absyn_Syntax.kun) +in (let _157_756 = (let _157_755 = (FStar_Absyn_Syntax.targ body) +in (_157_755)::[]) +in (FStar_Absyn_Util.mk_typ_app _157_757 _157_756))) +in (FStar_All.pipe_left setpos _157_758)))))) end)) end | FStar_Util.Inr (Some (x), t) -> begin ( -let _62_2095 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) -in (match (_62_2095) with +let _62_2112 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) +in (match (_62_2112) with | (env, x) -> begin ( @@ -2562,24 +2575,24 @@ let body = (match (pats) with | [] -> begin body end -| _62_2100 -> begin +| _62_2117 -> begin (FStar_Absyn_Syntax.mk_Typ_meta (FStar_Absyn_Syntax.Meta_pattern (((body), (pats))))) end) in ( -let body = (let _157_753 = (let _157_752 = (let _157_751 = (let _157_750 = (FStar_Absyn_Syntax.v_binder (FStar_Absyn_Util.bvd_to_bvar_s x t)) -in (_157_750)::[]) -in ((_157_751), (body))) -in (FStar_Absyn_Syntax.mk_Typ_lam _157_752)) -in (FStar_All.pipe_left pos _157_753)) -in (let _157_757 = (let _157_756 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange) FStar_Absyn_Syntax.kun) -in (let _157_755 = (let _157_754 = (FStar_Absyn_Syntax.targ body) -in (_157_754)::[]) -in (FStar_Absyn_Util.mk_typ_app _157_756 _157_755))) -in (FStar_All.pipe_left setpos _157_757)))))) +let body = (let _157_764 = (let _157_763 = (let _157_762 = (let _157_761 = (FStar_Absyn_Syntax.v_binder (FStar_Absyn_Util.bvd_to_bvar_s x t)) +in (_157_761)::[]) +in ((_157_762), (body))) +in (FStar_Absyn_Syntax.mk_Typ_lam _157_763)) +in (FStar_All.pipe_left pos _157_764)) +in (let _157_768 = (let _157_767 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange) FStar_Absyn_Syntax.kun) +in (let _157_766 = (let _157_765 = (FStar_Absyn_Syntax.targ body) +in (_157_765)::[]) +in (FStar_Absyn_Util.mk_typ_app _157_767 _157_766))) +in (FStar_All.pipe_left setpos _157_768)))))) end)) end -| _62_2104 -> begin +| _62_2121 -> begin (FStar_All.failwith "impossible") end)))) in ( @@ -2591,17 +2604,17 @@ let push_quant = (fun q binders pats body -> (match (binders) with let rest = (b')::_rest in ( -let body = (let _157_772 = (q ((rest), (pats), (body))) -in (let _157_771 = (FStar_Range.union_ranges b'.FStar_Parser_AST.brange body.FStar_Parser_AST.range) -in (FStar_Parser_AST.mk_term _157_772 _157_771 FStar_Parser_AST.Formula))) -in (let _157_773 = (q (((b)::[]), ([]), (body))) -in (FStar_Parser_AST.mk_term _157_773 f.FStar_Parser_AST.range FStar_Parser_AST.Formula)))) +let body = (let _157_783 = (q ((rest), (pats), (body))) +in (let _157_782 = (FStar_Range.union_ranges b'.FStar_Parser_AST.brange body.FStar_Parser_AST.range) +in (FStar_Parser_AST.mk_term _157_783 _157_782 FStar_Parser_AST.Formula))) +in (let _157_784 = (q (((b)::[]), ([]), (body))) +in (FStar_Parser_AST.mk_term _157_784 f.FStar_Parser_AST.range FStar_Parser_AST.Formula)))) end -| _62_2118 -> begin +| _62_2135 -> begin (FStar_All.failwith "impossible") end)) -in (match ((let _157_774 = (unparen f) -in _157_774.FStar_Parser_AST.tm)) with +in (match ((let _157_785 = (unparen f) +in _157_785.FStar_Parser_AST.tm)) with | FStar_Parser_AST.Labeled (f, l, p) -> begin ( @@ -2614,8 +2627,8 @@ end let args = (hd)::_args in ( -let args = (FStar_List.map (fun t -> (let _157_776 = (desugar_typ_or_exp env t) -in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_776))) args) +let args = (FStar_List.map (fun t -> (let _157_787 = (desugar_typ_or_exp env t) +in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _157_787))) args) in ( let eq = if (is_type env hd) then begin @@ -2627,32 +2640,32 @@ in (FStar_Absyn_Util.mk_typ_app eq args)))) end | FStar_Parser_AST.Op (s, args) -> begin (match ((((connective s)), (args))) with -| (Some (conn), (_62_2144)::(_62_2142)::[]) -> begin -(let _157_780 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range conn f.FStar_Parser_AST.range) FStar_Absyn_Syntax.kun) -in (let _157_779 = (FStar_List.map (fun x -> (let _157_778 = (desugar_formula env x) -in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_778))) args) -in (FStar_Absyn_Util.mk_typ_app _157_780 _157_779))) +| (Some (conn), (_62_2161)::(_62_2159)::[]) -> begin +(let _157_791 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range conn f.FStar_Parser_AST.range) FStar_Absyn_Syntax.kun) +in (let _157_790 = (FStar_List.map (fun x -> (let _157_789 = (desugar_formula env x) +in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_789))) args) +in (FStar_Absyn_Util.mk_typ_app _157_791 _157_790))) end -| _62_2149 -> begin +| _62_2166 -> begin if (is_type env f) then begin (desugar_typ env f) end else begin -(let _157_781 = (desugar_exp env f) -in (FStar_All.pipe_right _157_781 FStar_Absyn_Util.b2t)) +(let _157_792 = (desugar_exp env f) +in (FStar_All.pipe_right _157_792 FStar_Absyn_Util.b2t)) end end) end | FStar_Parser_AST.If (f1, f2, f3) -> begin -(let _157_785 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range FStar_Absyn_Const.ite_lid f.FStar_Parser_AST.range) FStar_Absyn_Syntax.kun) -in (let _157_784 = (FStar_List.map (fun x -> (match ((desugar_typ_or_exp env x)) with +(let _157_796 = (FStar_Absyn_Util.ftv (FStar_Ident.set_lid_range FStar_Absyn_Const.ite_lid f.FStar_Parser_AST.range) FStar_Absyn_Syntax.kun) +in (let _157_795 = (FStar_List.map (fun x -> (match ((desugar_typ_or_exp env x)) with | FStar_Util.Inl (t) -> begin (FStar_Absyn_Syntax.targ t) end | FStar_Util.Inr (v) -> begin -(let _157_783 = (FStar_Absyn_Util.b2t v) -in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_783)) +(let _157_794 = (FStar_Absyn_Util.b2t v) +in (FStar_All.pipe_left FStar_Absyn_Syntax.targ _157_794)) end)) ((f1)::(f2)::(f3)::[])) -in (FStar_Absyn_Util.mk_typ_app _157_785 _157_784))) +in (FStar_Absyn_Util.mk_typ_app _157_796 _157_795))) end | (FStar_Parser_AST.QForall ([], _, _)) | (FStar_Parser_AST.QExists ([], _, _)) -> begin (FStar_All.failwith "Impossible: Quantifier without binders") @@ -2661,15 +2674,15 @@ end ( let binders = (_1)::(_2)::_3 -in (let _157_787 = (push_quant (fun x -> FStar_Parser_AST.QForall (x)) binders pats body) -in (desugar_formula env _157_787))) +in (let _157_798 = (push_quant (fun x -> FStar_Parser_AST.QForall (x)) binders pats body) +in (desugar_formula env _157_798))) end | FStar_Parser_AST.QExists ((_1)::(_2)::_3, pats, body) -> begin ( let binders = (_1)::(_2)::_3 -in (let _157_789 = (push_quant (fun x -> FStar_Parser_AST.QExists (x)) binders pats body) -in (desugar_formula env _157_789))) +in (let _157_800 = (push_quant (fun x -> FStar_Parser_AST.QExists (x)) binders pats body) +in (desugar_formula env _157_800))) end | FStar_Parser_AST.QForall ((b)::[], pats, body) -> begin (desugar_quant FStar_Absyn_Const.forall_lid FStar_Absyn_Const.allTyp_lid b pats body) @@ -2680,41 +2693,41 @@ end | FStar_Parser_AST.Paren (f) -> begin (desugar_formula env f) end -| _62_2211 -> begin +| _62_2228 -> begin if (is_type env f) then begin (desugar_typ env f) end else begin -(let _157_790 = (desugar_exp env f) -in (FStar_All.pipe_left FStar_Absyn_Util.b2t _157_790)) +(let _157_801 = (desugar_exp env f) +in (FStar_All.pipe_left FStar_Absyn_Util.b2t _157_801)) end end))))))) and desugar_formula : env_t -> FStar_Parser_AST.term -> FStar_Absyn_Syntax.typ = (fun env t -> (desugar_formula' ( -let _62_2214 = env -in {FStar_Parser_DesugarEnv.curmodule = _62_2214.FStar_Parser_DesugarEnv.curmodule; FStar_Parser_DesugarEnv.modules = _62_2214.FStar_Parser_DesugarEnv.modules; FStar_Parser_DesugarEnv.open_namespaces = _62_2214.FStar_Parser_DesugarEnv.open_namespaces; FStar_Parser_DesugarEnv.modul_abbrevs = _62_2214.FStar_Parser_DesugarEnv.modul_abbrevs; FStar_Parser_DesugarEnv.sigaccum = _62_2214.FStar_Parser_DesugarEnv.sigaccum; FStar_Parser_DesugarEnv.localbindings = _62_2214.FStar_Parser_DesugarEnv.localbindings; FStar_Parser_DesugarEnv.recbindings = _62_2214.FStar_Parser_DesugarEnv.recbindings; FStar_Parser_DesugarEnv.phase = FStar_Parser_AST.Formula; FStar_Parser_DesugarEnv.sigmap = _62_2214.FStar_Parser_DesugarEnv.sigmap; FStar_Parser_DesugarEnv.default_result_effect = _62_2214.FStar_Parser_DesugarEnv.default_result_effect; FStar_Parser_DesugarEnv.iface = _62_2214.FStar_Parser_DesugarEnv.iface; FStar_Parser_DesugarEnv.admitted_iface = _62_2214.FStar_Parser_DesugarEnv.admitted_iface}) t)) +let _62_2231 = env +in {FStar_Parser_DesugarEnv.curmodule = _62_2231.FStar_Parser_DesugarEnv.curmodule; FStar_Parser_DesugarEnv.modules = _62_2231.FStar_Parser_DesugarEnv.modules; FStar_Parser_DesugarEnv.open_namespaces = _62_2231.FStar_Parser_DesugarEnv.open_namespaces; FStar_Parser_DesugarEnv.modul_abbrevs = _62_2231.FStar_Parser_DesugarEnv.modul_abbrevs; FStar_Parser_DesugarEnv.sigaccum = _62_2231.FStar_Parser_DesugarEnv.sigaccum; FStar_Parser_DesugarEnv.localbindings = _62_2231.FStar_Parser_DesugarEnv.localbindings; FStar_Parser_DesugarEnv.recbindings = _62_2231.FStar_Parser_DesugarEnv.recbindings; FStar_Parser_DesugarEnv.phase = FStar_Parser_AST.Formula; FStar_Parser_DesugarEnv.sigmap = _62_2231.FStar_Parser_DesugarEnv.sigmap; FStar_Parser_DesugarEnv.default_result_effect = _62_2231.FStar_Parser_DesugarEnv.default_result_effect; FStar_Parser_DesugarEnv.iface = _62_2231.FStar_Parser_DesugarEnv.iface; FStar_Parser_DesugarEnv.admitted_iface = _62_2231.FStar_Parser_DesugarEnv.admitted_iface}) t)) and desugar_binder : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.binder -> ((FStar_Ident.ident Prims.option * FStar_Absyn_Syntax.knd), (FStar_Ident.ident Prims.option * FStar_Absyn_Syntax.typ)) FStar_Util.either = (fun env b -> if (is_type_binder env b) then begin -(let _157_795 = (desugar_type_binder env b) -in FStar_Util.Inl (_157_795)) +(let _157_806 = (desugar_type_binder env b) +in FStar_Util.Inl (_157_806)) end else begin -(let _157_796 = (desugar_exp_binder env b) -in FStar_Util.Inr (_157_796)) +(let _157_807 = (desugar_exp_binder env b) +in FStar_Util.Inr (_157_807)) end) and typars_of_binders : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.binder Prims.list -> (FStar_Parser_DesugarEnv.env * ((((FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax FStar_Absyn_Syntax.bvdef, FStar_Absyn_Syntax.knd) FStar_Absyn_Syntax.withinfo_t, ((FStar_Absyn_Syntax.exp', (FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax FStar_Absyn_Syntax.bvdef, FStar_Absyn_Syntax.typ) FStar_Absyn_Syntax.withinfo_t) FStar_Util.either * FStar_Absyn_Syntax.arg_qualifier Prims.option) Prims.list) = (fun env bs -> ( -let _62_2247 = (FStar_List.fold_left (fun _62_2222 b -> (match (_62_2222) with +let _62_2264 = (FStar_List.fold_left (fun _62_2239 b -> (match (_62_2239) with | (env, out) -> begin ( let tk = (desugar_binder env ( -let _62_2224 = b -in {FStar_Parser_AST.b = _62_2224.FStar_Parser_AST.b; FStar_Parser_AST.brange = _62_2224.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _62_2224.FStar_Parser_AST.aqual})) +let _62_2241 = b +in {FStar_Parser_AST.b = _62_2241.FStar_Parser_AST.b; FStar_Parser_AST.brange = _62_2241.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _62_2241.FStar_Parser_AST.aqual})) in (match (tk) with | FStar_Util.Inl (Some (a), k) -> begin ( -let _62_2234 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (match (_62_2234) with +let _62_2251 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (match (_62_2251) with | (env, a) -> begin ((env), ((((FStar_Util.Inl ((FStar_Absyn_Util.bvd_to_bvar_s a k))), ((trans_aqual b.FStar_Parser_AST.aqual))))::out)) end)) @@ -2722,61 +2735,61 @@ end | FStar_Util.Inr (Some (x), t) -> begin ( -let _62_2242 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) -in (match (_62_2242) with +let _62_2259 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) +in (match (_62_2259) with | (env, x) -> begin ((env), ((((FStar_Util.Inr ((FStar_Absyn_Util.bvd_to_bvar_s x t))), ((trans_aqual b.FStar_Parser_AST.aqual))))::out)) end)) end -| _62_2244 -> begin +| _62_2261 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected binder"), (b.FStar_Parser_AST.brange))))) end)) end)) ((env), ([])) bs) -in (match (_62_2247) with +in (match (_62_2264) with | (env, tpars) -> begin ((env), ((FStar_List.rev tpars))) end))) and desugar_exp_binder : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.binder -> (FStar_Ident.ident Prims.option * FStar_Absyn_Syntax.typ) = (fun env b -> (match (b.FStar_Parser_AST.b) with | FStar_Parser_AST.Annotated (x, t) -> begin -(let _157_803 = (desugar_typ env t) -in ((Some (x)), (_157_803))) +(let _157_814 = (desugar_typ env t) +in ((Some (x)), (_157_814))) end | FStar_Parser_AST.TVariable (t) -> begin -(let _157_804 = (FStar_Parser_DesugarEnv.fail_or2 (FStar_Parser_DesugarEnv.try_lookup_typ_var env) t) -in ((None), (_157_804))) +(let _157_815 = (FStar_Parser_DesugarEnv.fail_or2 (FStar_Parser_DesugarEnv.try_lookup_typ_var env) t) +in ((None), (_157_815))) end | FStar_Parser_AST.NoName (t) -> begin -(let _157_805 = (desugar_typ env t) -in ((None), (_157_805))) +(let _157_816 = (desugar_typ env t) +in ((None), (_157_816))) end | FStar_Parser_AST.Variable (x) -> begin ((Some (x)), (FStar_Absyn_Syntax.tun)) end -| _62_2261 -> begin +| _62_2278 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected domain of an arrow or sum (expected a type)"), (b.FStar_Parser_AST.brange))))) end)) and desugar_type_binder : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.binder -> (FStar_Ident.ident Prims.option * FStar_Absyn_Syntax.knd) = (fun env b -> ( -let fail = (fun _62_2265 -> (match (()) with +let fail = (fun _62_2282 -> (match (()) with | () -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected domain of an arrow or sum (expected a kind)"), (b.FStar_Parser_AST.brange))))) end)) in (match (b.FStar_Parser_AST.b) with | (FStar_Parser_AST.Annotated (x, t)) | (FStar_Parser_AST.TAnnotated (x, t)) -> begin -(let _157_810 = (desugar_kind env t) -in ((Some (x)), (_157_810))) +(let _157_821 = (desugar_kind env t) +in ((Some (x)), (_157_821))) end | FStar_Parser_AST.NoName (t) -> begin -(let _157_811 = (desugar_kind env t) -in ((None), (_157_811))) +(let _157_822 = (desugar_kind env t) +in ((None), (_157_822))) end | FStar_Parser_AST.TVariable (x) -> begin ((Some (x)), (( -let _62_2276 = FStar_Absyn_Syntax.mk_Kind_type -in {FStar_Absyn_Syntax.n = _62_2276.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_2276.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = b.FStar_Parser_AST.brange; FStar_Absyn_Syntax.fvs = _62_2276.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_2276.FStar_Absyn_Syntax.uvs}))) +let _62_2293 = FStar_Absyn_Syntax.mk_Kind_type +in {FStar_Absyn_Syntax.n = _62_2293.FStar_Absyn_Syntax.n; FStar_Absyn_Syntax.tk = _62_2293.FStar_Absyn_Syntax.tk; FStar_Absyn_Syntax.pos = b.FStar_Parser_AST.brange; FStar_Absyn_Syntax.fvs = _62_2293.FStar_Absyn_Syntax.fvs; FStar_Absyn_Syntax.uvs = _62_2293.FStar_Absyn_Syntax.uvs}))) end -| _62_2279 -> begin +| _62_2296 -> begin (fail ()) end))) @@ -2787,14 +2800,14 @@ let rec aux = (fun bs k -> (match (k.FStar_Absyn_Syntax.n) with | FStar_Absyn_Syntax.Kind_arrow (binders, k) -> begin (aux (FStar_List.append bs binders) k) end -| FStar_Absyn_Syntax.Kind_abbrev (_62_2290, k) -> begin +| FStar_Absyn_Syntax.Kind_abbrev (_62_2307, k) -> begin (aux bs k) end -| _62_2295 -> begin +| _62_2312 -> begin bs end)) -in (let _157_820 = (aux tps k) -in (FStar_All.pipe_right _157_820 FStar_Absyn_Util.name_binders)))) +in (let _157_831 = (aux tps k) +in (FStar_All.pipe_right _157_831 FStar_Absyn_Util.name_binders)))) let mk_data_discriminators : FStar_Absyn_Syntax.qualifier Prims.list -> FStar_Parser_DesugarEnv.env -> FStar_Ident.lid -> ((((FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax FStar_Absyn_Syntax.bvdef, (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.withinfo_t, ((FStar_Absyn_Syntax.exp', (FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax FStar_Absyn_Syntax.bvdef, (FStar_Absyn_Syntax.typ', (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.syntax) FStar_Absyn_Syntax.withinfo_t) FStar_Util.either * FStar_Absyn_Syntax.arg_qualifier Prims.option) Prims.list -> (FStar_Absyn_Syntax.knd', Prims.unit) FStar_Absyn_Syntax.syntax -> FStar_Ident.lident Prims.list -> FStar_Absyn_Syntax.sigelt Prims.list = (fun quals env t tps k datas -> ( @@ -2812,34 +2825,34 @@ in ( let p = (FStar_Ident.range_of_lid t) in ( -let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _62_2309 -> (match (_62_2309) with -| (x, _62_2308) -> begin +let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _62_2326 -> (match (_62_2326) with +| (x, _62_2325) -> begin ((x), (Some (imp_tag))) end)))) in ( -let binders = (let _157_841 = (let _157_840 = (let _157_839 = (let _157_838 = (let _157_837 = (FStar_Absyn_Util.ftv t FStar_Absyn_Syntax.kun) -in (let _157_836 = (FStar_Absyn_Util.args_of_non_null_binders binders) -in ((_157_837), (_157_836)))) -in (FStar_Absyn_Syntax.mk_Typ_app' _157_838 None p)) -in (FStar_All.pipe_left FStar_Absyn_Syntax.null_v_binder _157_839)) -in (_157_840)::[]) -in (FStar_List.append imp_binders _157_841)) +let binders = (let _157_852 = (let _157_851 = (let _157_850 = (let _157_849 = (let _157_848 = (FStar_Absyn_Util.ftv t FStar_Absyn_Syntax.kun) +in (let _157_847 = (FStar_Absyn_Util.args_of_non_null_binders binders) +in ((_157_848), (_157_847)))) +in (FStar_Absyn_Syntax.mk_Typ_app' _157_849 None p)) +in (FStar_All.pipe_left FStar_Absyn_Syntax.null_v_binder _157_850)) +in (_157_851)::[]) +in (FStar_List.append imp_binders _157_852)) in ( -let disc_type = (let _157_844 = (let _157_843 = (let _157_842 = (FStar_Absyn_Util.ftv FStar_Absyn_Const.bool_lid FStar_Absyn_Syntax.ktype) -in (FStar_Absyn_Util.total_comp _157_842 p)) -in ((binders), (_157_843))) -in (FStar_Absyn_Syntax.mk_Typ_fun _157_844 None p)) +let disc_type = (let _157_855 = (let _157_854 = (let _157_853 = (FStar_Absyn_Util.ftv FStar_Absyn_Const.bool_lid FStar_Absyn_Syntax.ktype) +in (FStar_Absyn_Util.total_comp _157_853 p)) +in ((binders), (_157_854))) +in (FStar_Absyn_Syntax.mk_Typ_fun _157_855 None p)) in (FStar_All.pipe_right datas (FStar_List.map (fun d -> ( let disc_name = (FStar_Absyn_Util.mk_discriminator d) -in (let _157_847 = (let _157_846 = (quals ((FStar_Absyn_Syntax.Logic)::(FStar_Absyn_Syntax.Discriminator (d))::[])) -in ((disc_name), (disc_type), (_157_846), ((FStar_Ident.range_of_lid disc_name)))) -in FStar_Absyn_Syntax.Sig_val_decl (_157_847))))))))))))) +in (let _157_858 = (let _157_857 = (quals ((FStar_Absyn_Syntax.Logic)::(FStar_Absyn_Syntax.Discriminator (d))::[])) +in ((disc_name), (disc_type), (_157_857), ((FStar_Ident.range_of_lid disc_name)))) +in FStar_Absyn_Syntax.Sig_val_decl (_157_858))))))))))))) -let mk_indexed_projectors = (fun fvq refine_domain env _62_2321 lid formals t -> (match (_62_2321) with +let mk_indexed_projectors = (fun fvq refine_domain env _62_2338 lid formals t -> (match (_62_2338) with | (tc, tps, k) -> begin ( @@ -2852,9 +2865,9 @@ in ( let pos = (fun q -> (FStar_Absyn_Syntax.withinfo q None p)) in ( -let projectee = (let _157_858 = (FStar_Absyn_Syntax.mk_ident (("projectee"), (p))) -in (let _157_857 = (FStar_Absyn_Util.genident (Some (p))) -in {FStar_Absyn_Syntax.ppname = _157_858; FStar_Absyn_Syntax.realname = _157_857})) +let projectee = (let _157_869 = (FStar_Absyn_Syntax.mk_ident (("projectee"), (p))) +in (let _157_868 = (FStar_Absyn_Util.genident (Some (p))) +in {FStar_Absyn_Syntax.ppname = _157_869; FStar_Absyn_Syntax.realname = _157_868})) in ( let arg_exp = (FStar_Absyn_Util.bvd_to_exp projectee FStar_Absyn_Syntax.tun) @@ -2862,10 +2875,10 @@ in ( let arg_binder = ( -let arg_typ = (let _157_861 = (let _157_860 = (FStar_Absyn_Util.ftv tc FStar_Absyn_Syntax.kun) -in (let _157_859 = (FStar_Absyn_Util.args_of_non_null_binders binders) -in ((_157_860), (_157_859)))) -in (FStar_Absyn_Syntax.mk_Typ_app' _157_861 None p)) +let arg_typ = (let _157_872 = (let _157_871 = (FStar_Absyn_Util.ftv tc FStar_Absyn_Syntax.kun) +in (let _157_870 = (FStar_Absyn_Util.args_of_non_null_binders binders) +in ((_157_871), (_157_870)))) +in (FStar_Absyn_Syntax.mk_Typ_app' _157_872 None p)) in if (not (refine_domain)) then begin (FStar_Absyn_Syntax.v_binder (FStar_Absyn_Util.bvd_to_bvar_s projectee arg_typ)) end else begin @@ -2875,22 +2888,22 @@ let disc_name = (FStar_Absyn_Util.mk_discriminator lid) in ( let x = (FStar_Absyn_Util.gen_bvar arg_typ) -in (let _157_871 = (let _157_870 = (let _157_869 = (let _157_868 = (let _157_867 = (let _157_866 = (let _157_865 = (FStar_Absyn_Util.fvar None disc_name p) -in (let _157_864 = (let _157_863 = (let _157_862 = (FStar_Absyn_Util.bvar_to_exp x) -in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_862)) -in (_157_863)::[]) -in ((_157_865), (_157_864)))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_866 None p)) -in (FStar_Absyn_Util.b2t _157_867)) -in ((x), (_157_868))) -in (FStar_Absyn_Syntax.mk_Typ_refine _157_869 None p)) -in (FStar_All.pipe_left (FStar_Absyn_Util.bvd_to_bvar_s projectee) _157_870)) -in (FStar_All.pipe_left FStar_Absyn_Syntax.v_binder _157_871)))) +in (let _157_882 = (let _157_881 = (let _157_880 = (let _157_879 = (let _157_878 = (let _157_877 = (let _157_876 = (FStar_Absyn_Util.fvar None disc_name p) +in (let _157_875 = (let _157_874 = (let _157_873 = (FStar_Absyn_Util.bvar_to_exp x) +in (FStar_All.pipe_left FStar_Absyn_Syntax.varg _157_873)) +in (_157_874)::[]) +in ((_157_876), (_157_875)))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_877 None p)) +in (FStar_Absyn_Util.b2t _157_878)) +in ((x), (_157_879))) +in (FStar_Absyn_Syntax.mk_Typ_refine _157_880 None p)) +in (FStar_All.pipe_left (FStar_Absyn_Util.bvd_to_bvar_s projectee) _157_881)) +in (FStar_All.pipe_left FStar_Absyn_Syntax.v_binder _157_882)))) end) in ( -let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _62_2338 -> (match (_62_2338) with -| (x, _62_2337) -> begin +let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _62_2355 -> (match (_62_2355) with +| (x, _62_2354) -> begin ((x), (Some (imp_tag))) end)))) in ( @@ -2901,73 +2914,73 @@ in ( let arg = (FStar_Absyn_Util.arg_of_non_null_binder arg_binder) in ( -let subst = (let _157_879 = (FStar_All.pipe_right formals (FStar_List.mapi (fun i f -> (match ((Prims.fst f)) with +let subst = (let _157_890 = (FStar_All.pipe_right formals (FStar_List.mapi (fun i f -> (match ((Prims.fst f)) with | FStar_Util.Inl (a) -> begin ( -let _62_2349 = (FStar_Absyn_Util.mk_field_projector_name lid a i) -in (match (_62_2349) with -| (field_name, _62_2348) -> begin +let _62_2366 = (FStar_Absyn_Util.mk_field_projector_name lid a i) +in (match (_62_2366) with +| (field_name, _62_2365) -> begin ( -let proj = (let _157_876 = (let _157_875 = (FStar_Absyn_Util.ftv field_name FStar_Absyn_Syntax.kun) -in ((_157_875), ((arg)::[]))) -in (FStar_Absyn_Syntax.mk_Typ_app _157_876 None p)) +let proj = (let _157_887 = (let _157_886 = (FStar_Absyn_Util.ftv field_name FStar_Absyn_Syntax.kun) +in ((_157_886), ((arg)::[]))) +in (FStar_Absyn_Syntax.mk_Typ_app _157_887 None p)) in (FStar_Util.Inl (((a.FStar_Absyn_Syntax.v), (proj))))::[]) end)) end | FStar_Util.Inr (x) -> begin ( -let _62_2356 = (FStar_Absyn_Util.mk_field_projector_name lid x i) -in (match (_62_2356) with -| (field_name, _62_2355) -> begin +let _62_2373 = (FStar_Absyn_Util.mk_field_projector_name lid x i) +in (match (_62_2373) with +| (field_name, _62_2372) -> begin ( -let proj = (let _157_878 = (let _157_877 = (FStar_Absyn_Util.fvar None field_name p) -in ((_157_877), ((arg)::[]))) -in (FStar_Absyn_Syntax.mk_Exp_app _157_878 None p)) +let proj = (let _157_889 = (let _157_888 = (FStar_Absyn_Util.fvar None field_name p) +in ((_157_888), ((arg)::[]))) +in (FStar_Absyn_Syntax.mk_Exp_app _157_889 None p)) in (FStar_Util.Inr (((x.FStar_Absyn_Syntax.v), (proj))))::[]) end)) end)))) -in (FStar_All.pipe_right _157_879 FStar_List.flatten)) +in (FStar_All.pipe_right _157_890 FStar_List.flatten)) in ( let ntps = (FStar_List.length tps) in ( -let all_params = (let _157_881 = (FStar_All.pipe_right tps (FStar_List.map (fun _62_2363 -> (match (_62_2363) with -| (b, _62_2362) -> begin +let all_params = (let _157_892 = (FStar_All.pipe_right tps (FStar_List.map (fun _62_2380 -> (match (_62_2380) with +| (b, _62_2379) -> begin ((b), (Some (imp_tag))) end)))) -in (FStar_List.append _157_881 formals)) -in (let _157_911 = (FStar_All.pipe_right formals (FStar_List.mapi (fun i ax -> (match ((Prims.fst ax)) with +in (FStar_List.append _157_892 formals)) +in (let _157_922 = (FStar_All.pipe_right formals (FStar_List.mapi (fun i ax -> (match ((Prims.fst ax)) with | FStar_Util.Inl (a) -> begin ( -let _62_2372 = (FStar_Absyn_Util.mk_field_projector_name lid a i) -in (match (_62_2372) with -| (field_name, _62_2371) -> begin +let _62_2389 = (FStar_Absyn_Util.mk_field_projector_name lid a i) +in (match (_62_2389) with +| (field_name, _62_2388) -> begin ( -let kk = (let _157_885 = (let _157_884 = (FStar_Absyn_Util.subst_kind subst a.FStar_Absyn_Syntax.sort) -in ((binders), (_157_884))) -in (FStar_Absyn_Syntax.mk_Kind_arrow _157_885 p)) +let kk = (let _157_896 = (let _157_895 = (FStar_Absyn_Util.subst_kind subst a.FStar_Absyn_Syntax.sort) +in ((binders), (_157_895))) +in (FStar_Absyn_Syntax.mk_Kind_arrow _157_896 p)) in (FStar_Absyn_Syntax.Sig_tycon (((field_name), ([]), (kk), ([]), ([]), ((FStar_Absyn_Syntax.Logic)::(FStar_Absyn_Syntax.Projector (((lid), (FStar_Util.Inl (a.FStar_Absyn_Syntax.v)))))::[]), ((FStar_Ident.range_of_lid field_name)))))::[]) end)) end | FStar_Util.Inr (x) -> begin ( -let _62_2379 = (FStar_Absyn_Util.mk_field_projector_name lid x i) -in (match (_62_2379) with -| (field_name, _62_2378) -> begin +let _62_2396 = (FStar_Absyn_Util.mk_field_projector_name lid x i) +in (match (_62_2396) with +| (field_name, _62_2395) -> begin ( -let t = (let _157_888 = (let _157_887 = (let _157_886 = (FStar_Absyn_Util.subst_typ subst x.FStar_Absyn_Syntax.sort) -in (FStar_Absyn_Util.total_comp _157_886 p)) -in ((binders), (_157_887))) -in (FStar_Absyn_Syntax.mk_Typ_fun _157_888 None p)) +let t = (let _157_899 = (let _157_898 = (let _157_897 = (FStar_Absyn_Util.subst_typ subst x.FStar_Absyn_Syntax.sort) +in (FStar_Absyn_Util.total_comp _157_897 p)) +in ((binders), (_157_898))) +in (FStar_Absyn_Syntax.mk_Typ_fun _157_899 None p)) in ( let quals = (fun q -> if ((not (env.FStar_Parser_DesugarEnv.iface)) || env.FStar_Parser_DesugarEnv.admitted_iface) then begin @@ -2980,10 +2993,10 @@ in ( let quals = (quals ((FStar_Absyn_Syntax.Logic)::(FStar_Absyn_Syntax.Projector (((lid), (FStar_Util.Inr (x.FStar_Absyn_Syntax.v)))))::[])) in ( -let impl = if (((let _157_891 = (FStar_Parser_DesugarEnv.current_module env) -in (FStar_Ident.lid_equals FStar_Absyn_Const.prims_lid _157_891)) || (fvq <> FStar_Absyn_Syntax.Data_ctor)) || (let _157_893 = (let _157_892 = (FStar_Parser_DesugarEnv.current_module env) -in _157_892.FStar_Ident.str) -in (FStar_Options.dont_gen_projectors _157_893))) then begin +let impl = if (((let _157_902 = (FStar_Parser_DesugarEnv.current_module env) +in (FStar_Ident.lid_equals FStar_Absyn_Const.prims_lid _157_902)) || (fvq <> FStar_Absyn_Syntax.Data_ctor)) || (let _157_904 = (let _157_903 = (FStar_Parser_DesugarEnv.current_module env) +in _157_903.FStar_Ident.str) +in (FStar_Options.dont_gen_projectors _157_904))) then begin [] end else begin ( @@ -2992,49 +3005,49 @@ let projection = (FStar_Absyn_Util.gen_bvar FStar_Absyn_Syntax.tun) in ( let as_imp = (fun _62_14 -> (match (_62_14) with -| Some (FStar_Absyn_Syntax.Implicit (_62_2387)) -> begin +| Some (FStar_Absyn_Syntax.Implicit (_62_2404)) -> begin true end -| _62_2391 -> begin +| _62_2408 -> begin false end)) in ( -let arg_pats = (let _157_908 = (FStar_All.pipe_right all_params (FStar_List.mapi (fun j by -> (match (by) with -| (FStar_Util.Inl (_62_2396), imp) -> begin +let arg_pats = (let _157_919 = (FStar_All.pipe_right all_params (FStar_List.mapi (fun j by -> (match (by) with +| (FStar_Util.Inl (_62_2413), imp) -> begin if (j < ntps) then begin [] end else begin -(let _157_901 = (let _157_900 = (let _157_899 = (let _157_898 = (FStar_Absyn_Util.gen_bvar FStar_Absyn_Syntax.kun) -in FStar_Absyn_Syntax.Pat_tvar (_157_898)) -in (pos _157_899)) -in ((_157_900), ((as_imp imp)))) -in (_157_901)::[]) +(let _157_912 = (let _157_911 = (let _157_910 = (let _157_909 = (FStar_Absyn_Util.gen_bvar FStar_Absyn_Syntax.kun) +in FStar_Absyn_Syntax.Pat_tvar (_157_909)) +in (pos _157_910)) +in ((_157_911), ((as_imp imp)))) +in (_157_912)::[]) end end -| (FStar_Util.Inr (_62_2401), imp) -> begin +| (FStar_Util.Inr (_62_2418), imp) -> begin if ((i + ntps) = j) then begin -(let _157_903 = (let _157_902 = (pos (FStar_Absyn_Syntax.Pat_var (projection))) -in ((_157_902), ((as_imp imp)))) -in (_157_903)::[]) +(let _157_914 = (let _157_913 = (pos (FStar_Absyn_Syntax.Pat_var (projection))) +in ((_157_913), ((as_imp imp)))) +in (_157_914)::[]) end else begin if (j < ntps) then begin [] end else begin -(let _157_907 = (let _157_906 = (let _157_905 = (let _157_904 = (FStar_Absyn_Util.gen_bvar FStar_Absyn_Syntax.tun) -in FStar_Absyn_Syntax.Pat_wild (_157_904)) -in (pos _157_905)) -in ((_157_906), ((as_imp imp)))) -in (_157_907)::[]) +(let _157_918 = (let _157_917 = (let _157_916 = (let _157_915 = (FStar_Absyn_Util.gen_bvar FStar_Absyn_Syntax.tun) +in FStar_Absyn_Syntax.Pat_wild (_157_915)) +in (pos _157_916)) +in ((_157_917), ((as_imp imp)))) +in (_157_918)::[]) end end end)))) -in (FStar_All.pipe_right _157_908 FStar_List.flatten)) +in (FStar_All.pipe_right _157_919 FStar_List.flatten)) in ( -let pat = (let _157_910 = (FStar_All.pipe_right (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv lid)), (Some (fvq)), (arg_pats)))) pos) -in (let _157_909 = (FStar_Absyn_Util.bvar_to_exp projection) -in ((_157_910), (None), (_157_909)))) +let pat = (let _157_921 = (FStar_All.pipe_right (FStar_Absyn_Syntax.Pat_cons ((((FStar_Absyn_Util.fv lid)), (Some (fvq)), (arg_pats)))) pos) +in (let _157_920 = (FStar_Absyn_Util.bvar_to_exp projection) +in ((_157_921), (None), (_157_920)))) in ( let body = (FStar_Absyn_Syntax.mk_Exp_match ((arg_exp), ((pat)::[])) None p) @@ -3049,33 +3062,33 @@ end in (FStar_Absyn_Syntax.Sig_val_decl (((field_name), (t), (quals), ((FStar_Ident.range_of_lid field_name)))))::impl)))) end)) end)))) -in (FStar_All.pipe_right _157_911 FStar_List.flatten)))))))))))))) +in (FStar_All.pipe_right _157_922 FStar_List.flatten)))))))))))))) end)) let mk_data_projectors : FStar_Parser_DesugarEnv.env -> FStar_Absyn_Syntax.sigelt -> FStar_Absyn_Syntax.sigelt Prims.list = (fun env _62_17 -> (match (_62_17) with -| FStar_Absyn_Syntax.Sig_datacon (lid, t, tycon, quals, _62_2418, _62_2420) when (not ((FStar_Ident.lid_equals lid FStar_Absyn_Const.lexcons_lid))) -> begin +| FStar_Absyn_Syntax.Sig_datacon (lid, t, tycon, quals, _62_2435, _62_2437) when (not ((FStar_Ident.lid_equals lid FStar_Absyn_Const.lexcons_lid))) -> begin ( let refine_domain = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _62_15 -> (match (_62_15) with -| FStar_Absyn_Syntax.RecordConstructor (_62_2425) -> begin +| FStar_Absyn_Syntax.RecordConstructor (_62_2442) -> begin true end -| _62_2428 -> begin +| _62_2445 -> begin false end)))) then begin false end else begin ( -let _62_2434 = tycon -in (match (_62_2434) with -| (l, _62_2431, _62_2433) -> begin +let _62_2451 = tycon +in (match (_62_2451) with +| (l, _62_2448, _62_2450) -> begin (match ((FStar_Parser_DesugarEnv.find_all_datacons env l)) with | Some (l) -> begin ((FStar_List.length l) > (Prims.parse_int "1")) end -| _62_2438 -> begin +| _62_2455 -> begin true end) end)) @@ -3091,7 +3104,7 @@ let qual = (match ((FStar_Util.find_map quals (fun _62_16 -> (match (_62_16) wit | FStar_Absyn_Syntax.RecordConstructor (fns) -> begin Some (FStar_Absyn_Syntax.Record_ctor (((lid), (fns)))) end -| _62_2449 -> begin +| _62_2466 -> begin None end)))) with | None -> begin @@ -3102,11 +3115,11 @@ q end) in (mk_indexed_projectors qual refine_domain env tycon lid formals cod))) end -| _62_2455 -> begin +| _62_2472 -> begin [] end)) end -| _62_2457 -> begin +| _62_2474 -> begin [] end)) @@ -3121,9 +3134,9 @@ in ( let binder_to_term = (fun b -> (match (b.FStar_Parser_AST.b) with | (FStar_Parser_AST.Annotated (x, _)) | (FStar_Parser_AST.Variable (x)) -> begin -(let _157_931 = (let _157_930 = (FStar_Ident.lid_of_ids ((x)::[])) -in FStar_Parser_AST.Var (_157_930)) -in (FStar_Parser_AST.mk_term _157_931 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) +(let _157_942 = (let _157_941 = (FStar_Ident.lid_of_ids ((x)::[])) +in FStar_Parser_AST.Var (_157_941)) +in (FStar_Parser_AST.mk_term _157_942 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) end | (FStar_Parser_AST.TAnnotated (a, _)) | (FStar_Parser_AST.TVariable (a)) -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.Tvar (a)) a.FStar_Ident.idRange FStar_Parser_AST.Type) @@ -3145,13 +3158,13 @@ let imp_of_aqual = (fun b -> (match (b.FStar_Parser_AST.aqual) with | Some (FStar_Parser_AST.Implicit) -> begin FStar_Parser_AST.Hash end -| _62_2522 -> begin +| _62_2539 -> begin FStar_Parser_AST.Nothing end)) -in (FStar_List.fold_left (fun out b -> (let _157_944 = (let _157_943 = (let _157_942 = (binder_to_term b) -in ((out), (_157_942), ((imp_of_aqual b)))) -in FStar_Parser_AST.App (_157_943)) -in (FStar_Parser_AST.mk_term _157_944 out.FStar_Parser_AST.range out.FStar_Parser_AST.level))) t binders))) +in (FStar_List.fold_left (fun out b -> (let _157_955 = (let _157_954 = (let _157_953 = (binder_to_term b) +in ((out), (_157_953), ((imp_of_aqual b)))) +in FStar_Parser_AST.App (_157_954)) +in (FStar_Parser_AST.mk_term _157_955 out.FStar_Parser_AST.range out.FStar_Parser_AST.level))) t binders))) in ( let tycon_record_as_variant = (fun _62_19 -> (match (_62_19) with @@ -3161,26 +3174,26 @@ let tycon_record_as_variant = (fun _62_19 -> (match (_62_19) with let constrName = (FStar_Ident.mk_ident (((Prims.strcat "Mk" id.FStar_Ident.idText)), (id.FStar_Ident.idRange))) in ( -let mfields = (FStar_List.map (fun _62_2537 -> (match (_62_2537) with -| (x, t, _62_2536) -> begin +let mfields = (FStar_List.map (fun _62_2554 -> (match (_62_2554) with +| (x, t, _62_2553) -> begin (FStar_Parser_AST.mk_binder (FStar_Parser_AST.Annotated ((((FStar_Absyn_Util.mangle_field_name x)), (t)))) x.FStar_Ident.idRange FStar_Parser_AST.Expr None) end)) fields) in ( -let result = (let _157_950 = (let _157_949 = (let _157_948 = (FStar_Ident.lid_of_ids ((id)::[])) -in FStar_Parser_AST.Var (_157_948)) -in (FStar_Parser_AST.mk_term _157_949 id.FStar_Ident.idRange FStar_Parser_AST.Type)) -in (apply_binders _157_950 parms)) +let result = (let _157_961 = (let _157_960 = (let _157_959 = (FStar_Ident.lid_of_ids ((id)::[])) +in FStar_Parser_AST.Var (_157_959)) +in (FStar_Parser_AST.mk_term _157_960 id.FStar_Ident.idRange FStar_Parser_AST.Type)) +in (apply_binders _157_961 parms)) in ( let constrTyp = (FStar_Parser_AST.mk_term (FStar_Parser_AST.Product (((mfields), ((with_constructor_effect result))))) id.FStar_Ident.idRange FStar_Parser_AST.Type) -in (let _157_952 = (FStar_All.pipe_right fields (FStar_List.map (fun _62_2546 -> (match (_62_2546) with -| (x, _62_2543, _62_2545) -> begin +in (let _157_963 = (FStar_All.pipe_right fields (FStar_List.map (fun _62_2563 -> (match (_62_2563) with +| (x, _62_2560, _62_2562) -> begin (FStar_Parser_DesugarEnv.qualify env x) end)))) -in ((FStar_Parser_AST.TyconVariant (((id), (parms), (kopt), ((((constrName), (Some (constrTyp)), (None), (false)))::[])))), (_157_952))))))) +in ((FStar_Parser_AST.TyconVariant (((id), (parms), (kopt), ((((constrName), (Some (constrTyp)), (None), (false)))::[])))), (_157_963))))))) end -| _62_2548 -> begin +| _62_2565 -> begin (FStar_All.failwith "impossible") end)) in ( @@ -3189,8 +3202,8 @@ let desugar_abstract_tc = (fun quals _env mutuals _62_20 -> (match (_62_20) with | FStar_Parser_AST.TyconAbstract (id, binders, kopt) -> begin ( -let _62_2562 = (typars_of_binders _env binders) -in (match (_62_2562) with +let _62_2579 = (typars_of_binders _env binders) +in (match (_62_2579) with | (_env', typars) -> begin ( @@ -3203,10 +3216,10 @@ end end) in ( -let tconstr = (let _157_963 = (let _157_962 = (let _157_961 = (FStar_Ident.lid_of_ids ((id)::[])) -in FStar_Parser_AST.Var (_157_961)) -in (FStar_Parser_AST.mk_term _157_962 id.FStar_Ident.idRange FStar_Parser_AST.Type)) -in (apply_binders _157_963 binders)) +let tconstr = (let _157_974 = (let _157_973 = (let _157_972 = (FStar_Ident.lid_of_ids ((id)::[])) +in FStar_Parser_AST.Var (_157_972)) +in (FStar_Parser_AST.mk_term _157_973 id.FStar_Ident.idRange FStar_Parser_AST.Type)) +in (apply_binders _157_974 binders)) in ( let qlid = (FStar_Parser_DesugarEnv.qualify _env id) @@ -3222,31 +3235,31 @@ let _env2 = (FStar_Parser_DesugarEnv.push_rec_binding _env' (FStar_Parser_Desuga in ((_env), (_env2), (se), (tconstr)))))))) end)) end -| _62_2573 -> begin +| _62_2590 -> begin (FStar_All.failwith "Unexpected tycon") end)) in ( let push_tparam = (fun env _62_21 -> (match (_62_21) with -| (FStar_Util.Inr (x), _62_2580) -> begin +| (FStar_Util.Inr (x), _62_2597) -> begin (FStar_Parser_DesugarEnv.push_bvvdef env x.FStar_Absyn_Syntax.v) end -| (FStar_Util.Inl (a), _62_2585) -> begin +| (FStar_Util.Inl (a), _62_2602) -> begin (FStar_Parser_DesugarEnv.push_btvdef env a.FStar_Absyn_Syntax.v) end)) in ( let push_tparams = (FStar_List.fold_left push_tparam) in (match (tcs) with -| (FStar_Parser_AST.TyconAbstract (_62_2589))::[] -> begin +| (FStar_Parser_AST.TyconAbstract (_62_2606))::[] -> begin ( let tc = (FStar_List.hd tcs) in ( -let _62_2600 = (desugar_abstract_tc quals env [] tc) -in (match (_62_2600) with -| (_62_2594, _62_2596, se, _62_2599) -> begin +let _62_2617 = (desugar_abstract_tc quals env [] tc) +in (match (_62_2617) with +| (_62_2611, _62_2613, se, _62_2616) -> begin ( let quals = if ((FStar_All.pipe_right quals (FStar_List.contains FStar_Absyn_Syntax.Assumption)) || (FStar_All.pipe_right quals (FStar_List.contains FStar_Absyn_Syntax.New))) then begin @@ -3254,11 +3267,11 @@ quals end else begin ( -let _62_2601 = (let _157_973 = (FStar_Range.string_of_range rng) -in (let _157_972 = (let _157_971 = (let _157_970 = (FStar_Absyn_Util.lids_of_sigelt se) -in (FStar_All.pipe_right _157_970 (FStar_List.map FStar_Absyn_Print.sli))) -in (FStar_All.pipe_right _157_971 (FStar_String.concat ", "))) -in (FStar_Util.print2 "%s (Warning): Adding an implicit \'new\' qualifier on %s\n" _157_973 _157_972))) +let _62_2618 = (let _157_984 = (FStar_Range.string_of_range rng) +in (let _157_983 = (let _157_982 = (let _157_981 = (FStar_Absyn_Util.lids_of_sigelt se) +in (FStar_All.pipe_right _157_981 (FStar_List.map FStar_Absyn_Print.sli))) +in (FStar_All.pipe_right _157_982 (FStar_String.concat ", "))) +in (FStar_Util.print2 "%s (Warning): Adding an implicit \'new\' qualifier on %s\n" _157_984 _157_983))) in (FStar_Absyn_Syntax.New)::quals) end in ( @@ -3270,8 +3283,8 @@ end | (FStar_Parser_AST.TyconAbbrev (id, binders, kopt, t))::[] -> begin ( -let _62_2614 = (typars_of_binders env binders) -in (match (_62_2614) with +let _62_2631 = (typars_of_binders env binders) +in (match (_62_2631) with | (env', typars) -> begin ( @@ -3281,7 +3294,7 @@ if (FStar_Util.for_some (fun _62_22 -> (match (_62_22) with | FStar_Absyn_Syntax.Effect -> begin true end -| _62_2619 -> begin +| _62_2636 -> begin false end)) quals) then begin FStar_Absyn_Syntax.mk_Kind_effect @@ -3301,7 +3314,7 @@ let quals = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _62_23 -> ( | FStar_Absyn_Syntax.Logic -> begin true end -| _62_2627 -> begin +| _62_2644 -> begin false end)))) then begin quals @@ -3318,23 +3331,23 @@ let se = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Absyn_Syntax. ( let c = (desugar_comp t.FStar_Parser_AST.range false env' t) -in (let _157_979 = (let _157_978 = (FStar_Parser_DesugarEnv.qualify env id) -in (let _157_977 = (FStar_All.pipe_right quals (FStar_List.filter (fun _62_24 -> (match (_62_24) with +in (let _157_990 = (let _157_989 = (FStar_Parser_DesugarEnv.qualify env id) +in (let _157_988 = (FStar_All.pipe_right quals (FStar_List.filter (fun _62_24 -> (match (_62_24) with | FStar_Absyn_Syntax.Effect -> begin false end -| _62_2633 -> begin +| _62_2650 -> begin true end)))) -in ((_157_978), (typars), (c), (_157_977), (rng)))) -in FStar_Absyn_Syntax.Sig_effect_abbrev (_157_979))) +in ((_157_989), (typars), (c), (_157_988), (rng)))) +in FStar_Absyn_Syntax.Sig_effect_abbrev (_157_990))) end else begin ( let t = (desugar_typ env' t) -in (let _157_981 = (let _157_980 = (FStar_Parser_DesugarEnv.qualify env id) -in ((_157_980), (typars), (k), (t), (quals), (rng))) -in FStar_Absyn_Syntax.Sig_typ_abbrev (_157_981))) +in (let _157_992 = (let _157_991 = (FStar_Parser_DesugarEnv.qualify env id) +in ((_157_991), (typars), (k), (t), (quals), (rng))) +in FStar_Absyn_Syntax.Sig_typ_abbrev (_157_992))) end in ( @@ -3342,19 +3355,19 @@ let env = (FStar_Parser_DesugarEnv.push_sigelt env se) in ((env), ((se)::[]))))))) end)) end -| (FStar_Parser_AST.TyconRecord (_62_2638))::[] -> begin +| (FStar_Parser_AST.TyconRecord (_62_2655))::[] -> begin ( let trec = (FStar_List.hd tcs) in ( -let _62_2644 = (tycon_record_as_variant trec) -in (match (_62_2644) with +let _62_2661 = (tycon_record_as_variant trec) +in (match (_62_2661) with | (t, fs) -> begin (desugar_tycon env rng ((FStar_Absyn_Syntax.RecordType (fs))::quals) ((t)::[])) end))) end -| (_62_2648)::_62_2646 -> begin +| (_62_2665)::_62_2663 -> begin ( let env0 = env @@ -3365,18 +3378,18 @@ in ( let rec collect_tcs = (fun quals et tc -> ( -let _62_2659 = et -in (match (_62_2659) with +let _62_2676 = et +in (match (_62_2676) with | (env, tcs) -> begin (match (tc) with -| FStar_Parser_AST.TyconRecord (_62_2661) -> begin +| FStar_Parser_AST.TyconRecord (_62_2678) -> begin ( let trec = tc in ( -let _62_2666 = (tycon_record_as_variant trec) -in (match (_62_2666) with +let _62_2683 = (tycon_record_as_variant trec) +in (match (_62_2683) with | (t, fs) -> begin (collect_tcs ((FStar_Absyn_Syntax.RecordType (fs))::quals) ((env), (tcs)) t) end))) @@ -3384,29 +3397,29 @@ end | FStar_Parser_AST.TyconVariant (id, binders, kopt, constructors) -> begin ( -let _62_2678 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) -in (match (_62_2678) with -| (env, _62_2675, se, tconstr) -> begin +let _62_2695 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) +in (match (_62_2695) with +| (env, _62_2692, se, tconstr) -> begin ((env), ((FStar_Util.Inl (((se), (constructors), (tconstr), (quals))))::tcs)) end)) end | FStar_Parser_AST.TyconAbbrev (id, binders, kopt, t) -> begin ( -let _62_2690 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) -in (match (_62_2690) with -| (env, _62_2687, se, tconstr) -> begin +let _62_2707 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) +in (match (_62_2707) with +| (env, _62_2704, se, tconstr) -> begin ((env), ((FStar_Util.Inr (((se), (t), (quals))))::tcs)) end)) end -| _62_2692 -> begin +| _62_2709 -> begin (FStar_All.failwith "Unrecognized mutual type definition") end) end))) in ( -let _62_2695 = (FStar_List.fold_left (collect_tcs quals) ((env), ([])) tcs) -in (match (_62_2695) with +let _62_2712 = (FStar_List.fold_left (collect_tcs quals) ((env), ([])) tcs) +in (match (_62_2712) with | (env, tcs) -> begin ( @@ -3414,7 +3427,7 @@ let tcs = (FStar_List.rev tcs) in ( let sigelts = (FStar_All.pipe_right tcs (FStar_List.collect (fun _62_26 -> (match (_62_26) with -| FStar_Util.Inr (FStar_Absyn_Syntax.Sig_tycon (id, tpars, k, _62_2702, _62_2704, _62_2706, _62_2708), t, quals) -> begin +| FStar_Util.Inr (FStar_Absyn_Syntax.Sig_tycon (id, tpars, k, _62_2719, _62_2721, _62_2723, _62_2725), t, quals) -> begin ( let env_tps = (push_tparams env tpars) @@ -3423,7 +3436,7 @@ in ( let t = (desugar_typ env_tps t) in (FStar_Absyn_Syntax.Sig_typ_abbrev (((id), (tpars), (k), (t), ([]), (rng))))::[])) end -| FStar_Util.Inl (FStar_Absyn_Syntax.Sig_tycon (tname, tpars, k, mutuals, _62_2722, tags, _62_2725), constrs, tconstr, quals) -> begin +| FStar_Util.Inl (FStar_Absyn_Syntax.Sig_tycon (tname, tpars, k, mutuals, _62_2739, tags, _62_2742), constrs, tconstr, quals) -> begin ( let tycon = ((tname), (tpars), (k)) @@ -3432,8 +3445,8 @@ in ( let env_tps = (push_tparams env tpars) in ( -let _62_2758 = (let _157_997 = (FStar_All.pipe_right constrs (FStar_List.map (fun _62_2740 -> (match (_62_2740) with -| (id, topt, _62_2738, of_notation) -> begin +let _62_2775 = (let _157_1008 = (FStar_All.pipe_right constrs (FStar_List.map (fun _62_2757 -> (match (_62_2757) with +| (id, topt, _62_2755, of_notation) -> begin ( let t = if of_notation then begin @@ -3455,9 +3468,9 @@ end) end in ( -let t = (let _157_992 = (FStar_Parser_DesugarEnv.default_total env_tps) -in (let _157_991 = (close env_tps t) -in (desugar_typ _157_992 _157_991))) +let t = (let _157_1003 = (FStar_Parser_DesugarEnv.default_total env_tps) +in (let _157_1002 = (close env_tps t) +in (desugar_typ _157_1003 _157_1002))) in ( let name = (FStar_Parser_DesugarEnv.qualify env id) @@ -3467,28 +3480,28 @@ let quals = (FStar_All.pipe_right tags (FStar_List.collect (fun _62_25 -> (match | FStar_Absyn_Syntax.RecordType (fns) -> begin (FStar_Absyn_Syntax.RecordConstructor (fns))::[] end -| _62_2754 -> begin +| _62_2771 -> begin [] end)))) -in (let _157_996 = (let _157_995 = (let _157_994 = (FStar_All.pipe_right t FStar_Absyn_Util.name_function_binders) -in ((name), (_157_994), (tycon), (quals), (mutuals), (rng))) -in FStar_Absyn_Syntax.Sig_datacon (_157_995)) -in ((name), (_157_996))))))) +in (let _157_1007 = (let _157_1006 = (let _157_1005 = (FStar_All.pipe_right t FStar_Absyn_Util.name_function_binders) +in ((name), (_157_1005), (tycon), (quals), (mutuals), (rng))) +in FStar_Absyn_Syntax.Sig_datacon (_157_1006)) +in ((name), (_157_1007))))))) end)))) -in (FStar_All.pipe_left FStar_List.split _157_997)) -in (match (_62_2758) with +in (FStar_All.pipe_left FStar_List.split _157_1008)) +in (match (_62_2775) with | (constrNames, constrs) -> begin (FStar_Absyn_Syntax.Sig_tycon (((tname), (tpars), (k), (mutuals), (constrNames), (tags), (rng))))::constrs end)))) end -| _62_2760 -> begin +| _62_2777 -> begin (FStar_All.failwith "impossible") end)))) in ( -let bundle = (let _157_999 = (let _157_998 = (FStar_List.collect FStar_Absyn_Util.lids_of_sigelt sigelts) -in ((sigelts), (quals), (_157_998), (rng))) -in FStar_Absyn_Syntax.Sig_bundle (_157_999)) +let bundle = (let _157_1010 = (let _157_1009 = (FStar_List.collect FStar_Absyn_Util.lids_of_sigelt sigelts) +in ((sigelts), (quals), (_157_1009), (rng))) +in FStar_Absyn_Syntax.Sig_bundle (_157_1010)) in ( let env = (FStar_Parser_DesugarEnv.push_sigelt env0 bundle) @@ -3498,10 +3511,10 @@ let data_ops = (FStar_All.pipe_right sigelts (FStar_List.collect (mk_data_projec in ( let discs = (FStar_All.pipe_right sigelts (FStar_List.collect (fun _62_27 -> (match (_62_27) with -| FStar_Absyn_Syntax.Sig_tycon (tname, tps, k, _62_2770, constrs, quals, _62_2774) -> begin +| FStar_Absyn_Syntax.Sig_tycon (tname, tps, k, _62_2787, constrs, quals, _62_2791) -> begin (mk_data_discriminators quals env tname tps k constrs) end -| _62_2778 -> begin +| _62_2795 -> begin [] end)))) in ( @@ -3520,36 +3533,36 @@ end))))))))))) let desugar_binders : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.binder Prims.list -> (FStar_Parser_DesugarEnv.env * FStar_Absyn_Syntax.binder Prims.list) = (fun env binders -> ( -let _62_2809 = (FStar_List.fold_left (fun _62_2787 b -> (match (_62_2787) with +let _62_2826 = (FStar_List.fold_left (fun _62_2804 b -> (match (_62_2804) with | (env, binders) -> begin (match ((desugar_binder env b)) with | FStar_Util.Inl (Some (a), k) -> begin ( -let _62_2796 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) -in (match (_62_2796) with +let _62_2813 = (FStar_Parser_DesugarEnv.push_local_tbinding env a) +in (match (_62_2813) with | (env, a) -> begin -(let _157_1008 = (let _157_1007 = (FStar_Absyn_Syntax.t_binder (FStar_Absyn_Util.bvd_to_bvar_s a k)) -in (_157_1007)::binders) -in ((env), (_157_1008))) +(let _157_1019 = (let _157_1018 = (FStar_Absyn_Syntax.t_binder (FStar_Absyn_Util.bvd_to_bvar_s a k)) +in (_157_1018)::binders) +in ((env), (_157_1019))) end)) end | FStar_Util.Inr (Some (x), t) -> begin ( -let _62_2804 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) -in (match (_62_2804) with +let _62_2821 = (FStar_Parser_DesugarEnv.push_local_vbinding env x) +in (match (_62_2821) with | (env, x) -> begin -(let _157_1010 = (let _157_1009 = (FStar_Absyn_Syntax.v_binder (FStar_Absyn_Util.bvd_to_bvar_s x t)) -in (_157_1009)::binders) -in ((env), (_157_1010))) +(let _157_1021 = (let _157_1020 = (FStar_Absyn_Syntax.v_binder (FStar_Absyn_Util.bvd_to_bvar_s x t)) +in (_157_1020)::binders) +in ((env), (_157_1021))) end)) end -| _62_2806 -> begin +| _62_2823 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Missing name in binder"), (b.FStar_Parser_AST.brange))))) end) end)) ((env), ([])) binders) -in (match (_62_2809) with +in (match (_62_2826) with | (env, binders) -> begin ((env), ((FStar_List.rev binders))) end))) @@ -3604,7 +3617,7 @@ let rec desugar_decl : env_t -> FStar_Parser_AST.decl -> (env_t * FStar_Absy let trans_quals = (trans_quals d.FStar_Parser_AST.drange) in (match (d.FStar_Parser_AST.d) with -| FStar_Parser_AST.Fsdoc (_62_2840) -> begin +| FStar_Parser_AST.Fsdoc (_62_2857) -> begin ((env), ([])) end | FStar_Parser_AST.Pragma (p) -> begin @@ -3623,45 +3636,45 @@ let env = (FStar_Parser_DesugarEnv.push_namespace env lid) in ((env), ([]))) end | FStar_Parser_AST.ModuleAbbrev (x, l) -> begin -(let _157_1028 = (FStar_Parser_DesugarEnv.push_module_abbrev env x l) -in ((_157_1028), ([]))) +(let _157_1039 = (FStar_Parser_DesugarEnv.push_module_abbrev env x l) +in ((_157_1039), ([]))) end | FStar_Parser_AST.Tycon (qual, tcs) -> begin ( -let tcs = (FStar_List.map (fun _62_2861 -> (match (_62_2861) with -| (x, _62_2860) -> begin +let tcs = (FStar_List.map (fun _62_2878 -> (match (_62_2878) with +| (x, _62_2877) -> begin x end)) tcs) -in (let _157_1030 = (trans_quals qual) -in (desugar_tycon env d.FStar_Parser_AST.drange _157_1030 tcs))) +in (let _157_1041 = (trans_quals qual) +in (desugar_tycon env d.FStar_Parser_AST.drange _157_1041 tcs))) end | FStar_Parser_AST.TopLevelLet (quals, isrec, lets) -> begin -(match ((let _157_1032 = (let _157_1031 = (desugar_exp_maybe_top true env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((isrec), (lets), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Const (FStar_Const.Const_unit)) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr))))) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr)) -in (FStar_All.pipe_left FStar_Absyn_Util.compress_exp _157_1031)) -in _157_1032.FStar_Absyn_Syntax.n)) with -| FStar_Absyn_Syntax.Exp_let (lbs, _62_2870) -> begin +(match ((let _157_1043 = (let _157_1042 = (desugar_exp_maybe_top true env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((isrec), (lets), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Const (FStar_Const.Const_unit)) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr))))) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr)) +in (FStar_All.pipe_left FStar_Absyn_Util.compress_exp _157_1042)) +in _157_1043.FStar_Absyn_Syntax.n)) with +| FStar_Absyn_Syntax.Exp_let (lbs, _62_2887) -> begin ( let lids = (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.map (fun lb -> (match (lb.FStar_Absyn_Syntax.lbname) with | FStar_Util.Inr (l) -> begin l end -| _62_2877 -> begin +| _62_2894 -> begin (FStar_All.failwith "impossible") end)))) in ( let quals = (match (quals) with -| (_62_2882)::_62_2880 -> begin +| (_62_2899)::_62_2897 -> begin (trans_quals quals) end -| _62_2885 -> begin +| _62_2902 -> begin (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.collect (fun _62_30 -> (match (_62_30) with -| {FStar_Absyn_Syntax.lbname = FStar_Util.Inl (_62_2894); FStar_Absyn_Syntax.lbtyp = _62_2892; FStar_Absyn_Syntax.lbeff = _62_2890; FStar_Absyn_Syntax.lbdef = _62_2888} -> begin +| {FStar_Absyn_Syntax.lbname = FStar_Util.Inl (_62_2911); FStar_Absyn_Syntax.lbtyp = _62_2909; FStar_Absyn_Syntax.lbeff = _62_2907; FStar_Absyn_Syntax.lbdef = _62_2905} -> begin [] end -| {FStar_Absyn_Syntax.lbname = FStar_Util.Inr (l); FStar_Absyn_Syntax.lbtyp = _62_2902; FStar_Absyn_Syntax.lbeff = _62_2900; FStar_Absyn_Syntax.lbdef = _62_2898} -> begin +| {FStar_Absyn_Syntax.lbname = FStar_Util.Inr (l); FStar_Absyn_Syntax.lbtyp = _62_2919; FStar_Absyn_Syntax.lbeff = _62_2917; FStar_Absyn_Syntax.lbdef = _62_2915} -> begin (FStar_Parser_DesugarEnv.lookup_letbinding_quals env l) end)))) end) @@ -3673,7 +3686,7 @@ in ( let env = (FStar_Parser_DesugarEnv.push_sigelt env s) in ((env), ((s)::[])))))) end -| _62_2910 -> begin +| _62_2927 -> begin (FStar_All.failwith "Desugaring a let did not produce a let") end) end @@ -3690,30 +3703,30 @@ end ( let f = (desugar_formula env t) -in (let _157_1038 = (let _157_1037 = (let _157_1036 = (let _157_1035 = (FStar_Parser_DesugarEnv.qualify env id) -in ((_157_1035), (f), ((FStar_Absyn_Syntax.Assumption)::[]), (d.FStar_Parser_AST.drange))) -in FStar_Absyn_Syntax.Sig_assume (_157_1036)) -in (_157_1037)::[]) -in ((env), (_157_1038)))) +in (let _157_1049 = (let _157_1048 = (let _157_1047 = (let _157_1046 = (FStar_Parser_DesugarEnv.qualify env id) +in ((_157_1046), (f), ((FStar_Absyn_Syntax.Assumption)::[]), (d.FStar_Parser_AST.drange))) +in FStar_Absyn_Syntax.Sig_assume (_157_1047)) +in (_157_1048)::[]) +in ((env), (_157_1049)))) end | FStar_Parser_AST.Val (quals, id, t) -> begin ( -let t = (let _157_1039 = (close_fun env t) -in (desugar_typ env _157_1039)) +let t = (let _157_1050 = (close_fun env t) +in (desugar_typ env _157_1050)) in ( let quals = if (env.FStar_Parser_DesugarEnv.iface && env.FStar_Parser_DesugarEnv.admitted_iface) then begin -(let _157_1040 = (trans_quals quals) -in (FStar_Absyn_Syntax.Assumption)::_157_1040) +(let _157_1051 = (trans_quals quals) +in (FStar_Absyn_Syntax.Assumption)::_157_1051) end else begin (trans_quals quals) end in ( -let se = (let _157_1042 = (let _157_1041 = (FStar_Parser_DesugarEnv.qualify env id) -in ((_157_1041), (t), (quals), (d.FStar_Parser_AST.drange))) -in FStar_Absyn_Syntax.Sig_val_decl (_157_1042)) +let se = (let _157_1053 = (let _157_1052 = (FStar_Parser_DesugarEnv.qualify env id) +in ((_157_1052), (t), (quals), (d.FStar_Parser_AST.drange))) +in FStar_Absyn_Syntax.Sig_val_decl (_157_1053)) in ( let env = (FStar_Parser_DesugarEnv.push_sigelt env se) @@ -3752,12 +3765,12 @@ end let t = (desugar_typ env term) in ( -let t = (let _157_1047 = (let _157_1046 = (let _157_1043 = (FStar_Absyn_Syntax.null_v_binder t) -in (_157_1043)::[]) -in (let _157_1045 = (let _157_1044 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) FStar_Absyn_Const.exn_lid) -in (FStar_Absyn_Syntax.mk_Total _157_1044)) -in ((_157_1046), (_157_1045)))) -in (FStar_Absyn_Syntax.mk_Typ_fun _157_1047 None d.FStar_Parser_AST.drange)) +let t = (let _157_1058 = (let _157_1057 = (let _157_1054 = (FStar_Absyn_Syntax.null_v_binder t) +in (_157_1054)::[]) +in (let _157_1056 = (let _157_1055 = (FStar_Parser_DesugarEnv.fail_or env (FStar_Parser_DesugarEnv.try_lookup_typ_name env) FStar_Absyn_Const.exn_lid) +in (FStar_Absyn_Syntax.mk_Total _157_1055)) +in ((_157_1057), (_157_1056)))) +in (FStar_Absyn_Syntax.mk_Typ_fun _157_1058 None d.FStar_Parser_AST.drange)) in ( let l = (FStar_Parser_DesugarEnv.qualify env id) @@ -3784,8 +3797,8 @@ end | FStar_Parser_AST.KindAbbrev (id, binders, k) -> begin ( -let _62_2963 = (desugar_binders env binders) -in (match (_62_2963) with +let _62_2980 = (desugar_binders env binders) +in (match (_62_2980) with | (env_k, binders) -> begin ( @@ -3802,7 +3815,7 @@ let env = (FStar_Parser_DesugarEnv.push_sigelt env se) in ((env), ((se)::[])))))) end)) end -| FStar_Parser_AST.NewEffectForFree (_62_2969) -> begin +| FStar_Parser_AST.NewEffectForFree (_62_2986) -> begin (FStar_All.failwith "effects for free only supported in conjunction with --universes") end | FStar_Parser_AST.NewEffect (quals, FStar_Parser_AST.RedefineEffect (eff_name, eff_binders, defn)) -> begin @@ -3811,27 +3824,27 @@ end let env0 = env in ( -let _62_2982 = (desugar_binders env eff_binders) -in (match (_62_2982) with +let _62_2999 = (desugar_binders env eff_binders) +in (match (_62_2999) with | (env, binders) -> begin ( let defn = (desugar_typ env defn) in ( -let _62_2986 = (FStar_Absyn_Util.head_and_args defn) -in (match (_62_2986) with +let _62_3003 = (FStar_Absyn_Util.head_and_args defn) +in (match (_62_3003) with | (head, args) -> begin (match (head.FStar_Absyn_Syntax.n) with | FStar_Absyn_Syntax.Typ_const (eff) -> begin (match ((FStar_Parser_DesugarEnv.try_lookup_effect_defn env eff.FStar_Absyn_Syntax.v)) with | None -> begin -(let _157_1052 = (let _157_1051 = (let _157_1050 = (let _157_1049 = (let _157_1048 = (FStar_Absyn_Print.sli eff.FStar_Absyn_Syntax.v) -in (Prims.strcat _157_1048 " not found")) -in (Prims.strcat "Effect " _157_1049)) -in ((_157_1050), (d.FStar_Parser_AST.drange))) -in FStar_Absyn_Syntax.Error (_157_1051)) -in (Prims.raise _157_1052)) +(let _157_1063 = (let _157_1062 = (let _157_1061 = (let _157_1060 = (let _157_1059 = (FStar_Absyn_Print.sli eff.FStar_Absyn_Syntax.v) +in (Prims.strcat _157_1059 " not found")) +in (Prims.strcat "Effect " _157_1060)) +in ((_157_1061), (d.FStar_Parser_AST.drange))) +in FStar_Absyn_Syntax.Error (_157_1062)) +in (Prims.raise _157_1063)) end | Some (ed) -> begin ( @@ -3842,24 +3855,24 @@ in ( let sub = (FStar_Absyn_Util.subst_typ subst) in ( -let ed = (let _157_1070 = (FStar_Parser_DesugarEnv.qualify env0 eff_name) -in (let _157_1069 = (trans_quals quals) -in (let _157_1068 = (FStar_Absyn_Util.subst_kind subst ed.FStar_Absyn_Syntax.signature) -in (let _157_1067 = (sub ed.FStar_Absyn_Syntax.ret) -in (let _157_1066 = (sub ed.FStar_Absyn_Syntax.bind_wp) -in (let _157_1065 = (sub ed.FStar_Absyn_Syntax.bind_wlp) -in (let _157_1064 = (sub ed.FStar_Absyn_Syntax.if_then_else) -in (let _157_1063 = (sub ed.FStar_Absyn_Syntax.ite_wp) -in (let _157_1062 = (sub ed.FStar_Absyn_Syntax.ite_wlp) -in (let _157_1061 = (sub ed.FStar_Absyn_Syntax.wp_binop) -in (let _157_1060 = (sub ed.FStar_Absyn_Syntax.wp_as_type) -in (let _157_1059 = (sub ed.FStar_Absyn_Syntax.close_wp) -in (let _157_1058 = (sub ed.FStar_Absyn_Syntax.close_wp_t) -in (let _157_1057 = (sub ed.FStar_Absyn_Syntax.assert_p) -in (let _157_1056 = (sub ed.FStar_Absyn_Syntax.assume_p) -in (let _157_1055 = (sub ed.FStar_Absyn_Syntax.null_wp) -in (let _157_1054 = (sub ed.FStar_Absyn_Syntax.trivial) -in {FStar_Absyn_Syntax.mname = _157_1070; FStar_Absyn_Syntax.binders = binders; FStar_Absyn_Syntax.qualifiers = _157_1069; FStar_Absyn_Syntax.signature = _157_1068; FStar_Absyn_Syntax.ret = _157_1067; FStar_Absyn_Syntax.bind_wp = _157_1066; FStar_Absyn_Syntax.bind_wlp = _157_1065; FStar_Absyn_Syntax.if_then_else = _157_1064; FStar_Absyn_Syntax.ite_wp = _157_1063; FStar_Absyn_Syntax.ite_wlp = _157_1062; FStar_Absyn_Syntax.wp_binop = _157_1061; FStar_Absyn_Syntax.wp_as_type = _157_1060; FStar_Absyn_Syntax.close_wp = _157_1059; FStar_Absyn_Syntax.close_wp_t = _157_1058; FStar_Absyn_Syntax.assert_p = _157_1057; FStar_Absyn_Syntax.assume_p = _157_1056; FStar_Absyn_Syntax.null_wp = _157_1055; FStar_Absyn_Syntax.trivial = _157_1054}))))))))))))))))) +let ed = (let _157_1081 = (FStar_Parser_DesugarEnv.qualify env0 eff_name) +in (let _157_1080 = (trans_quals quals) +in (let _157_1079 = (FStar_Absyn_Util.subst_kind subst ed.FStar_Absyn_Syntax.signature) +in (let _157_1078 = (sub ed.FStar_Absyn_Syntax.ret) +in (let _157_1077 = (sub ed.FStar_Absyn_Syntax.bind_wp) +in (let _157_1076 = (sub ed.FStar_Absyn_Syntax.bind_wlp) +in (let _157_1075 = (sub ed.FStar_Absyn_Syntax.if_then_else) +in (let _157_1074 = (sub ed.FStar_Absyn_Syntax.ite_wp) +in (let _157_1073 = (sub ed.FStar_Absyn_Syntax.ite_wlp) +in (let _157_1072 = (sub ed.FStar_Absyn_Syntax.wp_binop) +in (let _157_1071 = (sub ed.FStar_Absyn_Syntax.wp_as_type) +in (let _157_1070 = (sub ed.FStar_Absyn_Syntax.close_wp) +in (let _157_1069 = (sub ed.FStar_Absyn_Syntax.close_wp_t) +in (let _157_1068 = (sub ed.FStar_Absyn_Syntax.assert_p) +in (let _157_1067 = (sub ed.FStar_Absyn_Syntax.assume_p) +in (let _157_1066 = (sub ed.FStar_Absyn_Syntax.null_wp) +in (let _157_1065 = (sub ed.FStar_Absyn_Syntax.trivial) +in {FStar_Absyn_Syntax.mname = _157_1081; FStar_Absyn_Syntax.binders = binders; FStar_Absyn_Syntax.qualifiers = _157_1080; FStar_Absyn_Syntax.signature = _157_1079; FStar_Absyn_Syntax.ret = _157_1078; FStar_Absyn_Syntax.bind_wp = _157_1077; FStar_Absyn_Syntax.bind_wlp = _157_1076; FStar_Absyn_Syntax.if_then_else = _157_1075; FStar_Absyn_Syntax.ite_wp = _157_1074; FStar_Absyn_Syntax.ite_wlp = _157_1073; FStar_Absyn_Syntax.wp_binop = _157_1072; FStar_Absyn_Syntax.wp_as_type = _157_1071; FStar_Absyn_Syntax.close_wp = _157_1070; FStar_Absyn_Syntax.close_wp_t = _157_1069; FStar_Absyn_Syntax.assert_p = _157_1068; FStar_Absyn_Syntax.assume_p = _157_1067; FStar_Absyn_Syntax.null_wp = _157_1066; FStar_Absyn_Syntax.trivial = _157_1065}))))))))))))))))) in ( let se = FStar_Absyn_Syntax.Sig_new_effect (((ed), (d.FStar_Parser_AST.drange))) @@ -3869,12 +3882,12 @@ let env = (FStar_Parser_DesugarEnv.push_sigelt env0 se) in ((env), ((se)::[]))))))) end) end -| _62_2998 -> begin -(let _157_1074 = (let _157_1073 = (let _157_1072 = (let _157_1071 = (FStar_Absyn_Print.typ_to_string head) -in (Prims.strcat _157_1071 " is not an effect")) -in ((_157_1072), (d.FStar_Parser_AST.drange))) -in FStar_Absyn_Syntax.Error (_157_1073)) -in (Prims.raise _157_1074)) +| _62_3015 -> begin +(let _157_1085 = (let _157_1084 = (let _157_1083 = (let _157_1082 = (FStar_Absyn_Print.typ_to_string head) +in (Prims.strcat _157_1082 " is not an effect")) +in ((_157_1083), (d.FStar_Parser_AST.drange))) +in FStar_Absyn_Syntax.Error (_157_1084)) +in (Prims.raise _157_1085)) end) end))) end))) @@ -3888,36 +3901,36 @@ in ( let env = (FStar_Parser_DesugarEnv.enter_monad_scope env eff_name) in ( -let _62_3013 = (desugar_binders env eff_binders) -in (match (_62_3013) with +let _62_3030 = (desugar_binders env eff_binders) +in (match (_62_3030) with | (env, binders) -> begin ( let eff_k = (desugar_kind env eff_kind) in ( -let _62_3024 = (FStar_All.pipe_right eff_decls (FStar_List.fold_left (fun _62_3017 decl -> (match (_62_3017) with +let _62_3041 = (FStar_All.pipe_right eff_decls (FStar_List.fold_left (fun _62_3034 decl -> (match (_62_3034) with | (env, out) -> begin ( -let _62_3021 = (desugar_decl env decl) -in (match (_62_3021) with +let _62_3038 = (desugar_decl env decl) +in (match (_62_3038) with | (env, ses) -> begin -(let _157_1078 = (let _157_1077 = (FStar_List.hd ses) -in (_157_1077)::out) -in ((env), (_157_1078))) +(let _157_1089 = (let _157_1088 = (FStar_List.hd ses) +in (_157_1088)::out) +in ((env), (_157_1089))) end)) end)) ((env), ([])))) -in (match (_62_3024) with +in (match (_62_3041) with | (env, decls) -> begin ( let decls = (FStar_List.rev decls) in ( -let lookup = (fun s -> (match ((let _157_1082 = (let _157_1081 = (FStar_Absyn_Syntax.mk_ident ((s), (d.FStar_Parser_AST.drange))) -in (FStar_Parser_DesugarEnv.qualify env _157_1081)) -in (FStar_Parser_DesugarEnv.try_resolve_typ_abbrev env _157_1082))) with +let lookup = (fun s -> (match ((let _157_1093 = (let _157_1092 = (FStar_Absyn_Syntax.mk_ident ((s), (d.FStar_Parser_AST.drange))) +in (FStar_Parser_DesugarEnv.qualify env _157_1092)) +in (FStar_Parser_DesugarEnv.try_resolve_typ_abbrev env _157_1093))) with | None -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((((Prims.strcat "Monad " (Prims.strcat eff_name.FStar_Ident.idText (Prims.strcat " expects definition of " s)))), (d.FStar_Parser_AST.drange))))) end @@ -3926,23 +3939,23 @@ t end)) in ( -let ed = (let _157_1098 = (FStar_Parser_DesugarEnv.qualify env0 eff_name) -in (let _157_1097 = (trans_quals quals) -in (let _157_1096 = (lookup "return") -in (let _157_1095 = (lookup "bind_wp") -in (let _157_1094 = (lookup "bind_wlp") -in (let _157_1093 = (lookup "if_then_else") -in (let _157_1092 = (lookup "ite_wp") -in (let _157_1091 = (lookup "ite_wlp") -in (let _157_1090 = (lookup "wp_binop") -in (let _157_1089 = (lookup "wp_as_type") -in (let _157_1088 = (lookup "close_wp") -in (let _157_1087 = (lookup "close_wp_t") -in (let _157_1086 = (lookup "assert_p") -in (let _157_1085 = (lookup "assume_p") -in (let _157_1084 = (lookup "null_wp") -in (let _157_1083 = (lookup "trivial") -in {FStar_Absyn_Syntax.mname = _157_1098; FStar_Absyn_Syntax.binders = binders; FStar_Absyn_Syntax.qualifiers = _157_1097; FStar_Absyn_Syntax.signature = eff_k; FStar_Absyn_Syntax.ret = _157_1096; FStar_Absyn_Syntax.bind_wp = _157_1095; FStar_Absyn_Syntax.bind_wlp = _157_1094; FStar_Absyn_Syntax.if_then_else = _157_1093; FStar_Absyn_Syntax.ite_wp = _157_1092; FStar_Absyn_Syntax.ite_wlp = _157_1091; FStar_Absyn_Syntax.wp_binop = _157_1090; FStar_Absyn_Syntax.wp_as_type = _157_1089; FStar_Absyn_Syntax.close_wp = _157_1088; FStar_Absyn_Syntax.close_wp_t = _157_1087; FStar_Absyn_Syntax.assert_p = _157_1086; FStar_Absyn_Syntax.assume_p = _157_1085; FStar_Absyn_Syntax.null_wp = _157_1084; FStar_Absyn_Syntax.trivial = _157_1083})))))))))))))))) +let ed = (let _157_1109 = (FStar_Parser_DesugarEnv.qualify env0 eff_name) +in (let _157_1108 = (trans_quals quals) +in (let _157_1107 = (lookup "return") +in (let _157_1106 = (lookup "bind_wp") +in (let _157_1105 = (lookup "bind_wlp") +in (let _157_1104 = (lookup "if_then_else") +in (let _157_1103 = (lookup "ite_wp") +in (let _157_1102 = (lookup "ite_wlp") +in (let _157_1101 = (lookup "wp_binop") +in (let _157_1100 = (lookup "wp_as_type") +in (let _157_1099 = (lookup "close_wp") +in (let _157_1098 = (lookup "close_wp_t") +in (let _157_1097 = (lookup "assert_p") +in (let _157_1096 = (lookup "assume_p") +in (let _157_1095 = (lookup "null_wp") +in (let _157_1094 = (lookup "trivial") +in {FStar_Absyn_Syntax.mname = _157_1109; FStar_Absyn_Syntax.binders = binders; FStar_Absyn_Syntax.qualifiers = _157_1108; FStar_Absyn_Syntax.signature = eff_k; FStar_Absyn_Syntax.ret = _157_1107; FStar_Absyn_Syntax.bind_wp = _157_1106; FStar_Absyn_Syntax.bind_wlp = _157_1105; FStar_Absyn_Syntax.if_then_else = _157_1104; FStar_Absyn_Syntax.ite_wp = _157_1103; FStar_Absyn_Syntax.ite_wlp = _157_1102; FStar_Absyn_Syntax.wp_binop = _157_1101; FStar_Absyn_Syntax.wp_as_type = _157_1100; FStar_Absyn_Syntax.close_wp = _157_1099; FStar_Absyn_Syntax.close_wp_t = _157_1098; FStar_Absyn_Syntax.assert_p = _157_1097; FStar_Absyn_Syntax.assume_p = _157_1096; FStar_Absyn_Syntax.null_wp = _157_1095; FStar_Absyn_Syntax.trivial = _157_1094})))))))))))))))) in ( let se = FStar_Absyn_Syntax.Sig_new_effect (((ed), (d.FStar_Parser_AST.drange))) @@ -3958,12 +3971,12 @@ end let lookup = (fun l -> (match ((FStar_Parser_DesugarEnv.try_lookup_effect_name env l)) with | None -> begin -(let _157_1105 = (let _157_1104 = (let _157_1103 = (let _157_1102 = (let _157_1101 = (FStar_Absyn_Print.sli l) -in (Prims.strcat _157_1101 " not found")) -in (Prims.strcat "Effect name " _157_1102)) -in ((_157_1103), (d.FStar_Parser_AST.drange))) -in FStar_Absyn_Syntax.Error (_157_1104)) -in (Prims.raise _157_1105)) +(let _157_1116 = (let _157_1115 = (let _157_1114 = (let _157_1113 = (let _157_1112 = (FStar_Absyn_Print.sli l) +in (Prims.strcat _157_1112 " not found")) +in (Prims.strcat "Effect name " _157_1113)) +in ((_157_1114), (d.FStar_Parser_AST.drange))) +in FStar_Absyn_Syntax.Error (_157_1115)) +in (Prims.raise _157_1116)) end | Some (l) -> begin l @@ -3980,13 +3993,13 @@ let non_reifiable = (fun _62_31 -> (match (_62_31) with | FStar_Parser_AST.NonReifiableLift (f) -> begin f end -| _62_3047 -> begin +| _62_3064 -> begin (Prims.raise (FStar_Absyn_Syntax.Error ((("Unexpected reifiable sub-effect"), (d.FStar_Parser_AST.drange))))) end)) in ( -let lift = (let _157_1108 = (non_reifiable l.FStar_Parser_AST.lift_op) -in (desugar_typ env _157_1108)) +let lift = (let _157_1119 = (non_reifiable l.FStar_Parser_AST.lift_op) +in (desugar_typ env _157_1119)) in ( let se = FStar_Absyn_Syntax.Sig_sub_effect ((({FStar_Absyn_Syntax.source = src; FStar_Absyn_Syntax.target = dst; FStar_Absyn_Syntax.lift = lift}), (d.FStar_Parser_AST.drange))) @@ -3994,12 +4007,12 @@ in ((env), ((se)::[])))))))) end))) -let desugar_decls : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.decl Prims.list -> (FStar_Parser_DesugarEnv.env * FStar_Absyn_Syntax.sigelts) = (fun env decls -> (FStar_List.fold_left (fun _62_3055 d -> (match (_62_3055) with +let desugar_decls : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.decl Prims.list -> (FStar_Parser_DesugarEnv.env * FStar_Absyn_Syntax.sigelts) = (fun env decls -> (FStar_List.fold_left (fun _62_3072 d -> (match (_62_3072) with | (env, sigelts) -> begin ( -let _62_3059 = (desugar_decl env d) -in (match (_62_3059) with +let _62_3076 = (desugar_decl env d) +in (match (_62_3076) with | (env, se) -> begin ((env), ((FStar_List.append sigelts se))) end)) @@ -4014,11 +4027,11 @@ let desugar_modul_common : FStar_Absyn_Syntax.modul Prims.option -> FStar_Pars let open_ns = (fun mname d -> ( let d = if ((FStar_List.length mname.FStar_Ident.ns) <> (Prims.parse_int "0")) then begin -(let _157_1133 = (let _157_1132 = (let _157_1130 = (FStar_Absyn_Syntax.lid_of_ids mname.FStar_Ident.ns) -in FStar_Parser_AST.Open (_157_1130)) -in (let _157_1131 = (FStar_Absyn_Syntax.range_of_lid mname) -in (FStar_Parser_AST.mk_decl _157_1132 _157_1131 None))) -in (_157_1133)::d) +(let _157_1144 = (let _157_1143 = (let _157_1141 = (FStar_Absyn_Syntax.lid_of_ids mname.FStar_Ident.ns) +in FStar_Parser_AST.Open (_157_1141)) +in (let _157_1142 = (FStar_Absyn_Syntax.range_of_lid mname) +in (FStar_Parser_AST.mk_decl _157_1143 _157_1142 None))) +in (_157_1144)::d) end else begin d end @@ -4034,23 +4047,23 @@ end end) in ( -let _62_3086 = (match (m) with +let _62_3103 = (match (m) with | FStar_Parser_AST.Interface (mname, decls, admitted) -> begin -(let _157_1135 = (FStar_Parser_DesugarEnv.prepare_module_or_interface true admitted env mname) -in (let _157_1134 = (open_ns mname decls) -in ((_157_1135), (mname), (_157_1134), (true)))) +(let _157_1146 = (FStar_Parser_DesugarEnv.prepare_module_or_interface true admitted env mname) +in (let _157_1145 = (open_ns mname decls) +in ((_157_1146), (mname), (_157_1145), (true)))) end | FStar_Parser_AST.Module (mname, decls) -> begin -(let _157_1137 = (FStar_Parser_DesugarEnv.prepare_module_or_interface false false env mname) -in (let _157_1136 = (open_ns mname decls) -in ((_157_1137), (mname), (_157_1136), (false)))) +(let _157_1148 = (FStar_Parser_DesugarEnv.prepare_module_or_interface false false env mname) +in (let _157_1147 = (open_ns mname decls) +in ((_157_1148), (mname), (_157_1147), (false)))) end) -in (match (_62_3086) with +in (match (_62_3103) with | ((env, pop_when_done), mname, decls, intf) -> begin ( -let _62_3089 = (desugar_decls env decls) -in (match (_62_3089) with +let _62_3106 = (desugar_decls env decls) +in (match (_62_3106) with | (env, sigelts) -> begin ( @@ -4067,7 +4080,7 @@ let m = if (FStar_Options.interactive_fsi ()) then begin | FStar_Parser_AST.Module (mname, decls) -> begin FStar_Parser_AST.Interface (((mname), (decls), (true))) end -| FStar_Parser_AST.Interface (mname, _62_3100, _62_3102) -> begin +| FStar_Parser_AST.Interface (mname, _62_3117, _62_3119) -> begin (FStar_All.failwith (Prims.strcat "Impossible: " mname.FStar_Ident.ident.FStar_Ident.idText)) end) end else begin @@ -4075,51 +4088,51 @@ m end in ( -let _62_3110 = (desugar_modul_common curmod env m) -in (match (_62_3110) with -| (x, y, _62_3109) -> begin +let _62_3127 = (desugar_modul_common curmod env m) +in (match (_62_3127) with +| (x, y, _62_3126) -> begin ((x), (y)) end)))) let desugar_modul : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.modul -> (env_t * FStar_Absyn_Syntax.modul) = (fun env m -> ( -let _62_3116 = (desugar_modul_common None env m) -in (match (_62_3116) with +let _62_3133 = (desugar_modul_common None env m) +in (match (_62_3133) with | (env, modul, pop_when_done) -> begin ( let env = (FStar_Parser_DesugarEnv.finish_module_or_interface env modul) in ( -let _62_3118 = if (FStar_Options.dump_module modul.FStar_Absyn_Syntax.name.FStar_Ident.str) then begin -(let _157_1148 = (FStar_Absyn_Print.modul_to_string modul) -in (FStar_Util.print1 "%s\n" _157_1148)) +let _62_3135 = if (FStar_Options.dump_module modul.FStar_Absyn_Syntax.name.FStar_Ident.str) then begin +(let _157_1159 = (FStar_Absyn_Print.modul_to_string modul) +in (FStar_Util.print1 "%s\n" _157_1159)) end else begin () end -in (let _157_1149 = if pop_when_done then begin +in (let _157_1160 = if pop_when_done then begin (FStar_Parser_DesugarEnv.export_interface modul.FStar_Absyn_Syntax.name env) end else begin env end -in ((_157_1149), (modul))))) +in ((_157_1160), (modul))))) end))) let desugar_file : FStar_Parser_DesugarEnv.env -> FStar_Parser_AST.file -> (FStar_Parser_DesugarEnv.env * FStar_Absyn_Syntax.modul Prims.list) = (fun env f -> ( -let _62_3131 = (FStar_List.fold_left (fun _62_3124 m -> (match (_62_3124) with +let _62_3148 = (FStar_List.fold_left (fun _62_3141 m -> (match (_62_3141) with | (env, mods) -> begin ( -let _62_3128 = (desugar_modul env m) -in (match (_62_3128) with +let _62_3145 = (desugar_modul env m) +in (match (_62_3145) with | (env, m) -> begin ((env), ((m)::mods)) end)) end)) ((env), ([])) f) -in (match (_62_3131) with +in (match (_62_3148) with | (env, mods) -> begin ((env), ((FStar_List.rev mods))) end))) @@ -4127,15 +4140,15 @@ end))) let add_modul_to_env : FStar_Absyn_Syntax.modul -> FStar_Parser_DesugarEnv.env -> FStar_Parser_DesugarEnv.env = (fun m en -> ( -let _62_3136 = (FStar_Parser_DesugarEnv.prepare_module_or_interface false false en m.FStar_Absyn_Syntax.name) -in (match (_62_3136) with +let _62_3153 = (FStar_Parser_DesugarEnv.prepare_module_or_interface false false en m.FStar_Absyn_Syntax.name) +in (match (_62_3153) with | (en, pop_when_done) -> begin ( let en = (FStar_List.fold_left FStar_Parser_DesugarEnv.push_sigelt ( -let _62_3137 = en -in {FStar_Parser_DesugarEnv.curmodule = Some (m.FStar_Absyn_Syntax.name); FStar_Parser_DesugarEnv.modules = _62_3137.FStar_Parser_DesugarEnv.modules; FStar_Parser_DesugarEnv.open_namespaces = _62_3137.FStar_Parser_DesugarEnv.open_namespaces; FStar_Parser_DesugarEnv.modul_abbrevs = _62_3137.FStar_Parser_DesugarEnv.modul_abbrevs; FStar_Parser_DesugarEnv.sigaccum = _62_3137.FStar_Parser_DesugarEnv.sigaccum; FStar_Parser_DesugarEnv.localbindings = _62_3137.FStar_Parser_DesugarEnv.localbindings; FStar_Parser_DesugarEnv.recbindings = _62_3137.FStar_Parser_DesugarEnv.recbindings; FStar_Parser_DesugarEnv.phase = _62_3137.FStar_Parser_DesugarEnv.phase; FStar_Parser_DesugarEnv.sigmap = _62_3137.FStar_Parser_DesugarEnv.sigmap; FStar_Parser_DesugarEnv.default_result_effect = _62_3137.FStar_Parser_DesugarEnv.default_result_effect; FStar_Parser_DesugarEnv.iface = _62_3137.FStar_Parser_DesugarEnv.iface; FStar_Parser_DesugarEnv.admitted_iface = _62_3137.FStar_Parser_DesugarEnv.admitted_iface}) m.FStar_Absyn_Syntax.exports) +let _62_3154 = en +in {FStar_Parser_DesugarEnv.curmodule = Some (m.FStar_Absyn_Syntax.name); FStar_Parser_DesugarEnv.modules = _62_3154.FStar_Parser_DesugarEnv.modules; FStar_Parser_DesugarEnv.open_namespaces = _62_3154.FStar_Parser_DesugarEnv.open_namespaces; FStar_Parser_DesugarEnv.modul_abbrevs = _62_3154.FStar_Parser_DesugarEnv.modul_abbrevs; FStar_Parser_DesugarEnv.sigaccum = _62_3154.FStar_Parser_DesugarEnv.sigaccum; FStar_Parser_DesugarEnv.localbindings = _62_3154.FStar_Parser_DesugarEnv.localbindings; FStar_Parser_DesugarEnv.recbindings = _62_3154.FStar_Parser_DesugarEnv.recbindings; FStar_Parser_DesugarEnv.phase = _62_3154.FStar_Parser_DesugarEnv.phase; FStar_Parser_DesugarEnv.sigmap = _62_3154.FStar_Parser_DesugarEnv.sigmap; FStar_Parser_DesugarEnv.default_result_effect = _62_3154.FStar_Parser_DesugarEnv.default_result_effect; FStar_Parser_DesugarEnv.iface = _62_3154.FStar_Parser_DesugarEnv.iface; FStar_Parser_DesugarEnv.admitted_iface = _62_3154.FStar_Parser_DesugarEnv.admitted_iface}) m.FStar_Absyn_Syntax.exports) in ( let env = (FStar_Parser_DesugarEnv.finish_module_or_interface en m) diff --git a/src/ocaml-output/FStar_Parser_Env.ml b/src/ocaml-output/FStar_Parser_Env.ml index d54b6be29e2..222859e580d 100755 --- a/src/ocaml-output/FStar_Parser_Env.ml +++ b/src/ocaml-output/FStar_Parser_Env.ml @@ -1,8 +1,153 @@ open Prims +type local_binding = +(FStar_Ident.ident * FStar_Syntax_Syntax.bv * Prims.bool) + + +type rec_binding = +(FStar_Ident.ident * FStar_Ident.lid * FStar_Syntax_Syntax.delta_depth) + + +type module_abbrev = +(FStar_Ident.ident * FStar_Ident.lident) + + +type open_kind = +| Open_module +| Open_namespace + + +let is_Open_module = (fun _discr_ -> (match (_discr_) with +| Open_module (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Open_namespace = (fun _discr_ -> (match (_discr_) with +| Open_namespace (_) -> begin +true +end +| _ -> begin +false +end)) + + +type open_module_or_namespace = +(FStar_Ident.lident * open_kind) + + +type record_or_dc = +{typename : FStar_Ident.lident; constrname : FStar_Ident.lident; parms : FStar_Syntax_Syntax.binders; fields : (FStar_Syntax_Syntax.fieldname * FStar_Syntax_Syntax.typ) Prims.list; is_record : Prims.bool} + + +let is_Mkrecord_or_dc : record_or_dc -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwith "Not yet implemented:is_Mkrecord_or_dc")))) + + +type scope_mod = +| Local_binding of local_binding +| Rec_binding of rec_binding +| Module_abbrev of module_abbrev +| Open_module_or_namespace of open_module_or_namespace +| Top_level_def of FStar_Ident.ident +| Record_or_dc of record_or_dc + + +let is_Local_binding = (fun _discr_ -> (match (_discr_) with +| Local_binding (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Rec_binding = (fun _discr_ -> (match (_discr_) with +| Rec_binding (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Module_abbrev = (fun _discr_ -> (match (_discr_) with +| Module_abbrev (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Open_module_or_namespace = (fun _discr_ -> (match (_discr_) with +| Open_module_or_namespace (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Top_level_def = (fun _discr_ -> (match (_discr_) with +| Top_level_def (_) -> begin +true +end +| _ -> begin +false +end)) + + +let is_Record_or_dc = (fun _discr_ -> (match (_discr_) with +| Record_or_dc (_) -> begin +true +end +| _ -> begin +false +end)) + + +let ___Local_binding____0 = (fun projectee -> (match (projectee) with +| Local_binding (_63_34) -> begin +_63_34 +end)) + + +let ___Rec_binding____0 = (fun projectee -> (match (projectee) with +| Rec_binding (_63_37) -> begin +_63_37 +end)) + + +let ___Module_abbrev____0 = (fun projectee -> (match (projectee) with +| Module_abbrev (_63_40) -> begin +_63_40 +end)) + + +let ___Open_module_or_namespace____0 = (fun projectee -> (match (projectee) with +| Open_module_or_namespace (_63_43) -> begin +_63_43 +end)) + + +let ___Top_level_def____0 = (fun projectee -> (match (projectee) with +| Top_level_def (_63_46) -> begin +_63_46 +end)) + + +let ___Record_or_dc____0 = (fun projectee -> (match (projectee) with +| Record_or_dc (_63_49) -> begin +_63_49 +end)) + + type env = -{curmodule : FStar_Ident.lident Prims.option; modules : (FStar_Ident.lident * FStar_Syntax_Syntax.modul) Prims.list; open_namespaces : FStar_Ident.lident Prims.list; modul_abbrevs : (FStar_Ident.ident * FStar_Ident.lident) Prims.list; sigaccum : FStar_Syntax_Syntax.sigelts; localbindings : (FStar_Ident.ident * FStar_Syntax_Syntax.bv * Prims.bool) Prims.list; recbindings : (FStar_Ident.ident * FStar_Ident.lid * FStar_Syntax_Syntax.delta_depth) Prims.list; sigmap : (FStar_Syntax_Syntax.sigelt * Prims.bool) FStar_Util.smap; default_result_effect : FStar_Ident.lident; iface : Prims.bool; admitted_iface : Prims.bool; expect_typ : Prims.bool} +{curmodule : FStar_Ident.lident Prims.option; curmonad : FStar_Ident.ident Prims.option; modules : (FStar_Ident.lident * FStar_Syntax_Syntax.modul) Prims.list; scope_mods : scope_mod Prims.list; sigaccum : FStar_Syntax_Syntax.sigelts; sigmap : (FStar_Syntax_Syntax.sigelt * Prims.bool) FStar_Util.smap; default_result_effect : FStar_Ident.lident; iface : Prims.bool; admitted_iface : Prims.bool; expect_typ : Prims.bool} let is_Mkenv : env -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwith "Not yet implemented:is_Mkenv")))) @@ -32,24 +177,17 @@ end)) let ___Term_name____0 = (fun projectee -> (match (projectee) with -| Term_name (_63_28) -> begin -_63_28 +| Term_name (_63_63) -> begin +_63_63 end)) let ___Eff_name____0 = (fun projectee -> (match (projectee) with -| Eff_name (_63_31) -> begin -_63_31 +| Eff_name (_63_66) -> begin +_63_66 end)) -type record_or_dc = -{typename : FStar_Ident.lident; constrname : FStar_Ident.lident; parms : FStar_Syntax_Syntax.binders; fields : (FStar_Syntax_Syntax.fieldname * FStar_Syntax_Syntax.typ) Prims.list; is_record : Prims.bool} - - -let is_Mkrecord_or_dc : record_or_dc -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwith "Not yet implemented:is_Mkrecord_or_dc")))) - - let open_modules : env -> (FStar_Ident.lident * FStar_Syntax_Syntax.modul) Prims.list = (fun e -> e.modules) @@ -62,54 +200,54 @@ m end)) -let qual : FStar_Ident.lident -> FStar_Ident.ident -> FStar_Ident.lident = (fun lid id -> (let _158_90 = (FStar_Ident.lid_of_ids (FStar_List.append lid.FStar_Ident.ns ((lid.FStar_Ident.ident)::(id)::[]))) -in (FStar_Ident.set_lid_range _158_90 id.FStar_Ident.idRange))) - - -let qualify : env -> FStar_Ident.ident -> FStar_Ident.lident = (fun env id -> (let _158_95 = (current_module env) -in (qual _158_95 id))) - +let qual : FStar_Ident.lident -> FStar_Ident.ident -> FStar_Ident.lident = FStar_Syntax_Util.qual_id -let qualify_lid : env -> FStar_Ident.lident -> FStar_Ident.lident = (fun env lid -> ( -let cur = (current_module env) -in (let _158_100 = (FStar_Ident.lid_of_ids (FStar_List.append cur.FStar_Ident.ns (FStar_List.append ((cur.FStar_Ident.ident)::[]) (FStar_List.append lid.FStar_Ident.ns ((lid.FStar_Ident.ident)::[]))))) -in (FStar_Ident.set_lid_range _158_100 (FStar_Ident.range_of_lid lid))))) +let qualify : env -> FStar_Ident.ident -> FStar_Ident.lident = (fun env id -> (match (env.curmonad) with +| None -> begin +(let _158_172 = (current_module env) +in (qual _158_172 id)) +end +| Some (monad) -> begin +(let _158_174 = (let _158_173 = (current_module env) +in (qual _158_173 monad)) +in (FStar_Syntax_Util.mk_field_projector_name_from_ident _158_174 id)) +end)) -let new_sigmap = (fun _63_52 -> (match (()) with +let new_sigmap = (fun _63_79 -> (match (()) with | () -> begin (FStar_Util.smap_create (Prims.parse_int "100")) end)) -let empty_env : Prims.unit -> env = (fun _63_53 -> (match (()) with +let empty_env : Prims.unit -> env = (fun _63_80 -> (match (()) with | () -> begin -(let _158_104 = (new_sigmap ()) -in {curmodule = None; modules = []; open_namespaces = []; modul_abbrevs = []; sigaccum = []; localbindings = []; recbindings = []; sigmap = _158_104; default_result_effect = FStar_Syntax_Const.effect_Tot_lid; iface = false; admitted_iface = false; expect_typ = false}) +(let _158_178 = (new_sigmap ()) +in {curmodule = None; curmonad = None; modules = []; scope_mods = []; sigaccum = []; sigmap = _158_178; default_result_effect = FStar_Syntax_Const.effect_Tot_lid; iface = false; admitted_iface = false; expect_typ = false}) end)) let sigmap : env -> (FStar_Syntax_Syntax.sigelt * Prims.bool) FStar_Util.smap = (fun env -> env.sigmap) -let has_all_in_scope : env -> Prims.bool = (fun env -> (FStar_List.existsb (fun _63_59 -> (match (_63_59) with -| (m, _63_58) -> begin +let has_all_in_scope : env -> Prims.bool = (fun env -> (FStar_List.existsb (fun _63_86 -> (match (_63_86) with +| (m, _63_85) -> begin (FStar_Ident.lid_equals m FStar_Syntax_Const.all_lid) end)) env.modules)) let default_total : env -> env = (fun env -> ( -let _63_61 = env -in {curmodule = _63_61.curmodule; modules = _63_61.modules; open_namespaces = _63_61.open_namespaces; modul_abbrevs = _63_61.modul_abbrevs; sigaccum = _63_61.sigaccum; localbindings = _63_61.localbindings; recbindings = _63_61.recbindings; sigmap = _63_61.sigmap; default_result_effect = FStar_Syntax_Const.effect_Tot_lid; iface = _63_61.iface; admitted_iface = _63_61.admitted_iface; expect_typ = _63_61.expect_typ})) +let _63_88 = env +in {curmodule = _63_88.curmodule; curmonad = _63_88.curmonad; modules = _63_88.modules; scope_mods = _63_88.scope_mods; sigaccum = _63_88.sigaccum; sigmap = _63_88.sigmap; default_result_effect = FStar_Syntax_Const.effect_Tot_lid; iface = _63_88.iface; admitted_iface = _63_88.admitted_iface; expect_typ = _63_88.expect_typ})) let default_ml : env -> env = (fun env -> if (has_all_in_scope env) then begin ( -let _63_64 = env -in {curmodule = _63_64.curmodule; modules = _63_64.modules; open_namespaces = _63_64.open_namespaces; modul_abbrevs = _63_64.modul_abbrevs; sigaccum = _63_64.sigaccum; localbindings = _63_64.localbindings; recbindings = _63_64.recbindings; sigmap = _63_64.sigmap; default_result_effect = FStar_Syntax_Const.effect_ML_lid; iface = _63_64.iface; admitted_iface = _63_64.admitted_iface; expect_typ = _63_64.expect_typ}) +let _63_91 = env +in {curmodule = _63_91.curmodule; curmonad = _63_91.curmonad; modules = _63_91.modules; scope_mods = _63_91.scope_mods; sigaccum = _63_91.sigaccum; sigmap = _63_91.sigmap; default_result_effect = FStar_Syntax_Const.effect_ML_lid; iface = _63_91.iface; admitted_iface = _63_91.admitted_iface; expect_typ = _63_91.expect_typ}) end else begin env end) @@ -119,12 +257,12 @@ let set_bv_range : FStar_Syntax_Syntax.bv -> FStar_Range.range -> FStar_Synt let id = ( -let _63_68 = bv.FStar_Syntax_Syntax.ppname -in {FStar_Ident.idText = _63_68.FStar_Ident.idText; FStar_Ident.idRange = r}) +let _63_95 = bv.FStar_Syntax_Syntax.ppname +in {FStar_Ident.idText = _63_95.FStar_Ident.idText; FStar_Ident.idRange = r}) in ( -let _63_71 = bv -in {FStar_Syntax_Syntax.ppname = id; FStar_Syntax_Syntax.index = _63_71.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _63_71.FStar_Syntax_Syntax.sort}))) +let _63_98 = bv +in {FStar_Syntax_Syntax.ppname = id; FStar_Syntax_Syntax.index = _63_98.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _63_98.FStar_Syntax_Syntax.sort}))) let bv_to_name : FStar_Syntax_Syntax.bv -> FStar_Range.range -> FStar_Syntax_Syntax.term = (fun bv r -> (FStar_Syntax_Syntax.bv_to_name (set_bv_range bv r))) @@ -133,107 +271,319 @@ let bv_to_name : FStar_Syntax_Syntax.bv -> FStar_Range.range -> FStar_Syntax let unmangleMap : (Prims.string * Prims.string * FStar_Syntax_Syntax.delta_depth * FStar_Syntax_Syntax.fv_qual Prims.option) Prims.list = ((("op_ColonColon"), ("Cons"), (FStar_Syntax_Syntax.Delta_constant), (Some (FStar_Syntax_Syntax.Data_ctor))))::((("not"), ("op_Negation"), (FStar_Syntax_Syntax.Delta_equational), (None)))::[] -let unmangleOpName : FStar_Ident.ident -> FStar_Syntax_Syntax.term Prims.option = (fun id -> (FStar_Util.find_map unmangleMap (fun _63_80 -> (match (_63_80) with +let unmangleOpName : FStar_Ident.ident -> (FStar_Syntax_Syntax.term * Prims.bool) Prims.option = (fun id -> ( + +let t = (FStar_Util.find_map unmangleMap (fun _63_107 -> (match (_63_107) with | (x, y, dd, dq) -> begin if (id.FStar_Ident.idText = x) then begin -(let _158_126 = (let _158_125 = (FStar_Ident.lid_of_path (("Prims")::(y)::[]) id.FStar_Ident.idRange) -in (FStar_Syntax_Syntax.fvar _158_125 dd dq)) -in Some (_158_126)) +(let _158_200 = (let _158_199 = (FStar_Ident.lid_of_path (("Prims")::(y)::[]) id.FStar_Ident.idRange) +in (FStar_Syntax_Syntax.fvar _158_199 dd dq)) +in Some (_158_200)) end else begin None end -end)))) +end))) +in (match (t) with +| Some (v) -> begin +Some (((v), (false))) +end +| None -> begin +None +end))) -let try_lookup_id : env -> FStar_Ident.ident -> (FStar_Syntax_Syntax.term * Prims.bool) Prims.option = (fun env id -> (match ((unmangleOpName id)) with -| Some (f) -> begin -Some (((f), (false))) +type 'a cont_t = +| Cont_ok of 'a +| Cont_fail +| Cont_ignore + + +let is_Cont_ok = (fun _ _discr_ -> (match (_discr_) with +| Cont_ok (_) -> begin +true end -| _63_86 -> begin -(FStar_Util.find_map env.localbindings (fun _63_1 -> (match (_63_1) with -| (id', x, mut) when (id'.FStar_Ident.idText = id.FStar_Ident.idText) -> begin -(let _158_133 = (let _158_132 = (bv_to_name x id.FStar_Ident.idRange) -in ((_158_132), (mut))) -in Some (_158_133)) +| _ -> begin +false +end)) + + +let is_Cont_fail = (fun _ _discr_ -> (match (_discr_) with +| Cont_fail (_) -> begin +true end -| _63_93 -> begin +| _ -> begin +false +end)) + + +let is_Cont_ignore = (fun _ _discr_ -> (match (_discr_) with +| Cont_ignore (_) -> begin +true +end +| _ -> begin +false +end)) + + +let ___Cont_ok____0 = (fun projectee -> (match (projectee) with +| Cont_ok (_63_115) -> begin +_63_115 +end)) + + +let option_of_cont = (fun k_ignore _63_1 -> (match (_63_1) with +| Cont_ok (a) -> begin +Some (a) +end +| Cont_fail -> begin None -end))) +end +| Cont_ignore -> begin +(k_ignore ()) end)) -let resolve_in_open_namespaces' = (fun env lid finder -> ( +let find_in_record = (fun ns id record cont -> ( + +let needs_constrname = (not ((FStar_Syntax_Util.field_projector_contains_constructor id.FStar_Ident.idText))) +in ( + +let constrname = record.constrname.FStar_Ident.ident +in ( -let aux = (fun namespaces -> (match ((finder lid)) with +let fname = if needs_constrname then begin +(let _158_231 = (FStar_Ident.lid_of_ids (FStar_List.append ns ((constrname)::[]))) +in (FStar_Syntax_Util.mk_field_projector_name_from_ident _158_231 id)) +end else begin +(FStar_Ident.lid_of_ids (FStar_List.append ns ((id)::[]))) +end +in ( + +let fname = (FStar_Ident.set_lid_range fname id.FStar_Ident.idRange) +in ( + +let find = (FStar_Util.find_map record.fields (fun _63_134 -> (match (_63_134) with +| (f, _63_133) -> begin +if (FStar_Ident.lid_equals fname f) then begin +Some (((record), (fname))) +end else begin +None +end +end))) +in (match (find) with | Some (r) -> begin -Some (r) +(cont r) end -| _63_103 -> begin -( +| None -> begin +Cont_ignore +end))))))) + -let ids = (FStar_Ident.ids_of_lid lid) -in (FStar_Util.find_map namespaces (fun ns -> ( +let try_lookup_id'' = (fun env id k_local_binding k_rec_binding k_record find_in_module lookup_default_id -> ( -let full_name = (FStar_Ident.lid_of_ids (FStar_List.append (FStar_Ident.ids_of_lid ns) ids)) -in (finder full_name))))) +let check_local_binding_id = (fun _63_2 -> (match (_63_2) with +| (id', _63_150, _63_152) -> begin +(id'.FStar_Ident.idText = id.FStar_Ident.idText) end)) -in (let _158_144 = (let _158_143 = (current_module env) -in (_158_143)::env.open_namespaces) -in (aux _158_144)))) +in ( +let check_rec_binding_id = (fun _63_3 -> (match (_63_3) with +| (id', _63_158, _63_160) -> begin +(id'.FStar_Ident.idText = id.FStar_Ident.idText) +end)) +in ( -let expand_module_abbrev : env -> FStar_Ident.lident -> FStar_Ident.lident = (fun env lid -> (match (lid.FStar_Ident.ns) with -| (_63_112)::_63_110 -> begin -lid +let curmod_ns = (let _158_262 = (current_module env) +in (FStar_Ident.ids_of_lid _158_262)) +in ( + +let proc = (fun _63_4 -> (match (_63_4) with +| Local_binding (l) when (check_local_binding_id l) -> begin +(k_local_binding l) end -| [] -> begin +| Rec_binding (r) when (check_rec_binding_id r) -> begin +(k_rec_binding r) +end +| Open_module_or_namespace (ns, _63_171) -> begin ( -let id = lid.FStar_Ident.ident -in (match ((FStar_List.tryFind (fun _63_119 -> (match (_63_119) with -| (id', _63_118) -> begin -(id.FStar_Ident.idText = id'.FStar_Ident.idText) -end)) env.modul_abbrevs)) with +let lid = (qual ns id) +in (find_in_module lid)) +end +| Top_level_def (id') when (id'.FStar_Ident.idText = id.FStar_Ident.idText) -> begin +(lookup_default_id Cont_ignore id) +end +| Record_or_dc (r) -> begin +(find_in_record curmod_ns id r k_record) +end +| _63_180 -> begin +Cont_ignore +end)) +in ( + +let rec aux = (fun _63_5 -> (match (_63_5) with +| (a)::q -> begin +(let _158_268 = (proc a) +in (option_of_cont (fun _63_187 -> (aux q)) _158_268)) +end +| [] -> begin +(let _158_270 = (lookup_default_id Cont_fail id) +in (option_of_cont (fun _63_190 -> None) _158_270)) +end)) +in (aux env.scope_mods))))))) + + +let found_local_binding = (fun _63_195 -> (match (_63_195) with +| (id', x, mut) -> begin +(let _158_272 = (bv_to_name x id'.FStar_Ident.idRange) +in ((_158_272), (mut))) +end)) + + +let find_in_module = (fun env lid k_global_def k_not_found -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with +| Some (sb) -> begin +(k_global_def lid sb) +end | None -> begin -lid +k_not_found +end)) + + +let try_lookup_id : env -> FStar_Ident.ident -> (FStar_Syntax_Syntax.term * Prims.bool) Prims.option = (fun env id -> (match ((unmangleOpName id)) with +| Some (f) -> begin +Some (f) end -| Some (_63_122, lid') -> begin -lid' +| _63_208 -> begin +(try_lookup_id'' env id (fun r -> (let _158_288 = (found_local_binding r) +in Cont_ok (_158_288))) (fun _63_220 -> Cont_fail) (fun _63_218 -> Cont_ignore) (fun i -> (find_in_module env i (fun _63_214 _63_216 -> Cont_fail) Cont_ignore)) (fun _63_209 _63_211 -> Cont_fail)) end)) + + +let lookup_default_id = (fun env id k_global_def k_not_found -> ( + +let find_in_monad = (match (env.curmonad) with +| Some (_63_229) -> begin +( + +let lid = (qualify env id) +in (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with +| Some (r) -> begin +(let _158_306 = (k_global_def lid r) +in Some (_158_306)) +end +| None -> begin +None +end)) +end +| None -> begin +None +end) +in (match (find_in_monad) with +| Some (v) -> begin +v +end +| None -> begin +( + +let lid = (let _158_307 = (current_module env) +in (qual _158_307 id)) +in (find_in_module env lid k_global_def k_not_found)) +end))) + + +let module_is_defined : env -> FStar_Ident.lident -> Prims.bool = (fun env lid -> ((let _158_312 = (current_module env) +in (FStar_Ident.lid_equals lid _158_312)) || (FStar_List.existsb (fun x -> (FStar_Ident.lid_equals lid (Prims.fst x))) env.modules))) + + +let resolve_module_name : env -> FStar_Ident.lident -> Prims.bool -> FStar_Ident.lident Prims.option = (fun env lid honor_ns -> ( + +let nslen = (FStar_List.length lid.FStar_Ident.ns) +in ( + +let rec aux = (fun _63_6 -> (match (_63_6) with +| [] -> begin +if (module_is_defined env lid) then begin +Some (lid) +end else begin +None +end +end +| (Open_module_or_namespace (ns, Open_namespace))::q when honor_ns -> begin +( + +let new_lid = (let _158_324 = (let _158_323 = (FStar_Ident.path_of_lid ns) +in (let _158_322 = (FStar_Ident.path_of_lid lid) +in (FStar_List.append _158_323 _158_322))) +in (FStar_Ident.lid_of_path _158_324 (FStar_Ident.range_of_lid lid))) +in if (module_is_defined env new_lid) then begin +Some (new_lid) +end else begin +(aux q) +end) +end +| (Module_abbrev (name, modul))::_63_259 when ((nslen = (Prims.parse_int "0")) && (name.FStar_Ident.idText = lid.FStar_Ident.ident.FStar_Ident.idText)) -> begin +Some (modul) +end +| (_63_267)::q -> begin +(aux q) end)) +in (aux env.scope_mods)))) -let expand_module_abbrevs : env -> FStar_Ident.lident -> FStar_Ident.lident = (fun env lid -> (match (lid.FStar_Ident.ns) with -| (id)::rest -> begin -(match ((FStar_All.pipe_right env.modul_abbrevs (FStar_List.tryFind (fun _63_134 -> (match (_63_134) with -| (id', _63_133) -> begin -(id.FStar_Ident.idText = id'.FStar_Ident.idText) -end))))) with +let resolve_in_open_namespaces'' = (fun env lid k_local_binding k_rec_binding k_record f_module l_default -> (match (lid.FStar_Ident.ns) with +| (_63_280)::_63_278 -> begin +(match ((let _158_354 = (let _158_353 = (FStar_Ident.lid_of_ids lid.FStar_Ident.ns) +in (FStar_Ident.set_lid_range _158_353 (FStar_Ident.range_of_lid lid))) +in (resolve_module_name env _158_354 true))) with | None -> begin -lid +None end -| Some (_63_137, lid') -> begin -(FStar_Ident.lid_of_ids (FStar_List.append (FStar_Ident.ids_of_lid lid') (FStar_List.append rest ((lid.FStar_Ident.ident)::[])))) +| Some (modul) -> begin +( + +let lid' = (qual modul lid.FStar_Ident.ident) +in (let _158_356 = (f_module Cont_fail lid') +in (option_of_cont (fun _63_286 -> None) _158_356))) end) end -| _63_142 -> begin -lid +| [] -> begin +(try_lookup_id'' env lid.FStar_Ident.ident k_local_binding k_rec_binding k_record (f_module Cont_ignore) l_default) +end)) + + +let cont_of_option = (fun k_none _63_7 -> (match (_63_7) with +| Some (v) -> begin +Cont_ok (v) +end +| None -> begin +k_none end)) -let resolve_in_open_namespaces = (fun env lid finder -> (let _158_161 = (expand_module_abbrevs env lid) -in (resolve_in_open_namespaces' env _158_161 finder))) +let resolve_in_open_namespaces' = (fun env lid k_local_binding k_rec_binding k_global_def -> ( +let k_global_def' = (fun k lid def -> (let _158_382 = (k_global_def lid def) +in (cont_of_option k _158_382))) +in ( + +let f_module = (fun k lid' -> (find_in_module env lid' (k_global_def' k) k)) +in ( -let fv_qual_of_se : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.fv_qual Prims.option = (fun _63_3 -> (match (_63_3) with -| FStar_Syntax_Syntax.Sig_datacon (_63_149, _63_151, _63_153, l, _63_156, quals, _63_159, _63_161) -> begin +let l_default = (fun k i -> (lookup_default_id env i (k_global_def' k) k)) +in (resolve_in_open_namespaces'' env lid (fun l -> (let _158_392 = (k_local_binding l) +in (cont_of_option Cont_fail _158_392))) (fun r -> (let _158_394 = (k_rec_binding r) +in (cont_of_option Cont_fail _158_394))) (fun _63_311 -> Cont_ignore) f_module l_default))))) + + +let fv_qual_of_se : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.fv_qual Prims.option = (fun _63_9 -> (match (_63_9) with +| FStar_Syntax_Syntax.Sig_datacon (_63_317, _63_319, _63_321, l, _63_324, quals, _63_327, _63_329) -> begin ( -let qopt = (FStar_Util.find_map quals (fun _63_2 -> (match (_63_2) with +let qopt = (FStar_Util.find_map quals (fun _63_8 -> (match (_63_8) with | FStar_Syntax_Syntax.RecordConstructor (fs) -> begin Some (FStar_Syntax_Syntax.Record_ctor (((l), (fs)))) end -| _63_168 -> begin +| _63_336 -> begin None end))) in (match (qopt) with @@ -244,15 +594,15 @@ end x end)) end -| FStar_Syntax_Syntax.Sig_declare_typ (_63_173, _63_175, _63_177, quals, _63_180) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (_63_341, _63_343, _63_345, quals, _63_348) -> begin None end -| _63_184 -> begin +| _63_352 -> begin None end)) -let lb_fv : FStar_Syntax_Syntax.letbinding Prims.list -> FStar_Ident.lident -> FStar_Syntax_Syntax.fv = (fun lbs lid -> (let _158_170 = (FStar_Util.find_map lbs (fun lb -> ( +let lb_fv : FStar_Syntax_Syntax.letbinding Prims.list -> FStar_Ident.lident -> FStar_Syntax_Syntax.fv = (fun lbs lid -> (let _158_404 = (FStar_Util.find_map lbs (fun lb -> ( let fv = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) in if (FStar_Syntax_Syntax.fv_eq_lid fv lid) then begin @@ -260,7 +610,11 @@ Some (fv) end else begin None end))) -in (FStar_All.pipe_right _158_170 FStar_Util.must))) +in (FStar_All.pipe_right _158_404 FStar_Util.must))) + + +let ns_of_lid_equals : FStar_Ident.lident -> FStar_Ident.lident -> Prims.bool = (fun lid ns -> (((FStar_List.length lid.FStar_Ident.ns) = (FStar_List.length (FStar_Ident.ids_of_lid ns))) && (let _158_409 = (FStar_Ident.lid_of_ids lid.FStar_Ident.ns) +in (FStar_Ident.lid_equals _158_409 ns)))) let try_lookup_name : Prims.bool -> Prims.bool -> env -> FStar_Ident.lident -> foundname Prims.option = (fun any_val exclude_interf env lid -> ( @@ -268,43 +622,40 @@ let try_lookup_name : Prims.bool -> Prims.bool -> env -> FStar_Ident.liden let occurrence_range = (FStar_Ident.range_of_lid lid) in ( -let find_in_sig = (fun source_lid -> (match ((FStar_Util.smap_try_find (sigmap env) source_lid.FStar_Ident.str)) with -| Some (_63_197, true) when exclude_interf -> begin +let k_global_def = (fun source_lid _63_13 -> (match (_63_13) with +| (_63_368, true) when exclude_interf -> begin None end -| None -> begin -None -end -| Some (se, _63_204) -> begin +| (se, _63_373) -> begin (match (se) with -| FStar_Syntax_Syntax.Sig_inductive_typ (_63_208) -> begin -(let _158_183 = (let _158_182 = (let _158_181 = (FStar_Syntax_Syntax.fvar source_lid FStar_Syntax_Syntax.Delta_constant None) -in ((_158_181), (false))) -in Term_name (_158_182)) -in Some (_158_183)) -end -| FStar_Syntax_Syntax.Sig_datacon (_63_211) -> begin -(let _158_187 = (let _158_186 = (let _158_185 = (let _158_184 = (fv_qual_of_se se) -in (FStar_Syntax_Syntax.fvar source_lid FStar_Syntax_Syntax.Delta_constant _158_184)) -in ((_158_185), (false))) -in Term_name (_158_186)) -in Some (_158_187)) -end -| FStar_Syntax_Syntax.Sig_let ((_63_214, lbs), _63_218, _63_220, _63_222) -> begin +| FStar_Syntax_Syntax.Sig_inductive_typ (_63_376) -> begin +(let _158_424 = (let _158_423 = (let _158_422 = (FStar_Syntax_Syntax.fvar source_lid FStar_Syntax_Syntax.Delta_constant None) +in ((_158_422), (false))) +in Term_name (_158_423)) +in Some (_158_424)) +end +| FStar_Syntax_Syntax.Sig_datacon (_63_379) -> begin +(let _158_428 = (let _158_427 = (let _158_426 = (let _158_425 = (fv_qual_of_se se) +in (FStar_Syntax_Syntax.fvar source_lid FStar_Syntax_Syntax.Delta_constant _158_425)) +in ((_158_426), (false))) +in Term_name (_158_427)) +in Some (_158_428)) +end +| FStar_Syntax_Syntax.Sig_let ((_63_382, lbs), _63_386, _63_388, _63_390) -> begin ( let fv = (lb_fv lbs source_lid) -in (let _158_190 = (let _158_189 = (let _158_188 = (FStar_Syntax_Syntax.fvar source_lid fv.FStar_Syntax_Syntax.fv_delta fv.FStar_Syntax_Syntax.fv_qual) -in ((_158_188), (false))) -in Term_name (_158_189)) -in Some (_158_190))) +in (let _158_431 = (let _158_430 = (let _158_429 = (FStar_Syntax_Syntax.fvar source_lid fv.FStar_Syntax_Syntax.fv_delta fv.FStar_Syntax_Syntax.fv_qual) +in ((_158_429), (false))) +in Term_name (_158_430)) +in Some (_158_431))) end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_228, _63_230, quals, _63_233) -> begin -if (any_val || (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_4 -> (match (_63_4) with +| FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_396, _63_398, quals, _63_401) -> begin +if (any_val || (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_10 -> (match (_63_10) with | FStar_Syntax_Syntax.Assumption -> begin true end -| _63_239 -> begin +| _63_407 -> begin false end))))) then begin ( @@ -312,33 +663,37 @@ end))))) then begin let lid = (FStar_Ident.set_lid_range lid (FStar_Ident.range_of_lid source_lid)) in ( -let dd = if ((FStar_Syntax_Util.is_primop_lid lid) || ((FStar_Util.starts_with lid.FStar_Ident.nsstr "Prims.") && (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_5 -> (match (_63_5) with +let dd = if ((FStar_Syntax_Util.is_primop_lid lid) || ((ns_of_lid_equals lid FStar_Syntax_Const.prims_lid) && (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_11 -> (match (_63_11) with | (FStar_Syntax_Syntax.Projector (_)) | (FStar_Syntax_Syntax.Discriminator (_)) -> begin true end -| _63_249 -> begin +| _63_417 -> begin false end)))))) then begin FStar_Syntax_Syntax.Delta_equational end else begin FStar_Syntax_Syntax.Delta_constant end -in if (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Reflectable)) then begin +in (match ((FStar_Util.find_map quals (fun _63_12 -> (match (_63_12) with +| FStar_Syntax_Syntax.Reflectable (refl_monad) -> begin +Some (refl_monad) +end +| _63_423 -> begin +None +end)))) with +| Some (refl_monad) -> begin ( -let refl_monad = (let _158_194 = (FStar_All.pipe_right lid.FStar_Ident.ns (FStar_List.map (fun x -> x.FStar_Ident.idText))) -in (FStar_Ident.lid_of_path _158_194 occurrence_range)) -in ( - let refl_const = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reflect (refl_monad))) None occurrence_range) -in Some (Term_name (((refl_const), (false)))))) -end else begin -(let _158_198 = (let _158_197 = (let _158_196 = (let _158_195 = (fv_qual_of_se se) -in (FStar_Syntax_Syntax.fvar lid dd _158_195)) -in ((_158_196), (false))) -in Term_name (_158_197)) -in Some (_158_198)) -end)) +in Some (Term_name (((refl_const), (false))))) +end +| _63_428 -> begin +(let _158_438 = (let _158_437 = (let _158_436 = (let _158_435 = (fv_qual_of_se se) +in (FStar_Syntax_Syntax.fvar lid dd _158_435)) +in ((_158_436), (false))) +in Term_name (_158_437)) +in Some (_158_438)) +end))) end else begin None end @@ -346,55 +701,56 @@ end | (FStar_Syntax_Syntax.Sig_new_effect_for_free (ne, _)) | (FStar_Syntax_Syntax.Sig_new_effect (ne, _)) -> begin Some (Eff_name (((se), ((FStar_Ident.set_lid_range ne.FStar_Syntax_Syntax.mname (FStar_Ident.range_of_lid source_lid)))))) end -| FStar_Syntax_Syntax.Sig_effect_abbrev (_63_264) -> begin +| FStar_Syntax_Syntax.Sig_effect_abbrev (_63_439) -> begin Some (Eff_name (((se), (source_lid)))) end -| _63_267 -> begin +| _63_442 -> begin None end) end)) in ( -let found_id = (match (lid.FStar_Ident.ns) with -| [] -> begin -(match ((try_lookup_id env lid.FStar_Ident.ident)) with -| Some (e, mut) -> begin -Some (Term_name (((e), (mut)))) -end -| None -> begin -( +let k_local_binding = (fun r -> (let _158_442 = (let _158_441 = (found_local_binding r) +in Term_name (_158_441)) +in Some (_158_442))) +in ( -let recname = (qualify env lid.FStar_Ident.ident) -in (FStar_Util.find_map env.recbindings (fun _63_278 -> (match (_63_278) with +let k_rec_binding = (fun _63_449 -> (match (_63_449) with | (id, l, dd) -> begin -if (id.FStar_Ident.idText = lid.FStar_Ident.ident.FStar_Ident.idText) then begin -(let _158_202 = (let _158_201 = (let _158_200 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range l (FStar_Ident.range_of_lid lid)) dd None) -in ((_158_200), (false))) -in Term_name (_158_201)) -in Some (_158_202)) -end else begin -None +(let _158_447 = (let _158_446 = (let _158_445 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range l (FStar_Ident.range_of_lid lid)) dd None) +in ((_158_445), (false))) +in Term_name (_158_446)) +in Some (_158_447)) +end)) +in ( + +let found_unmangled = (match (lid.FStar_Ident.ns) with +| [] -> begin +(match ((unmangleOpName lid.FStar_Ident.ident)) with +| Some (f) -> begin +Some (Term_name (f)) end -end)))) +| _63_454 -> begin +None end) end -| _63_280 -> begin +| _63_456 -> begin None end) -in (match (found_id) with -| Some (_63_283) -> begin -found_id +in (match (found_unmangled) with +| None -> begin +(resolve_in_open_namespaces' env lid k_local_binding k_rec_binding k_global_def) end -| _63_286 -> begin -(resolve_in_open_namespaces env lid find_in_sig) -end))))) +| x -> begin +x +end))))))) let try_lookup_effect_name' : Prims.bool -> env -> FStar_Ident.lident -> (FStar_Syntax_Syntax.sigelt * FStar_Ident.lident) Prims.option = (fun exclude_interf env lid -> (match ((try_lookup_name true exclude_interf env lid)) with | Some (Eff_name (o, l)) -> begin Some (((o), (l))) end -| _63_296 -> begin +| _63_469 -> begin None end)) @@ -403,19 +759,19 @@ let try_lookup_effect_name : env -> FStar_Ident.lident -> FStar_Ident.lident | Some (o, l) -> begin Some (l) end -| _63_304 -> begin +| _63_477 -> begin None end)) let try_lookup_effect_defn : env -> FStar_Ident.lident -> FStar_Syntax_Syntax.eff_decl Prims.option = (fun env l -> (match ((try_lookup_effect_name' (not (env.iface)) env l)) with -| Some (FStar_Syntax_Syntax.Sig_new_effect (ne, _63_309), _63_313) -> begin +| Some (FStar_Syntax_Syntax.Sig_new_effect (ne, _63_482), _63_486) -> begin Some (ne) end -| Some (FStar_Syntax_Syntax.Sig_new_effect_for_free (ne, _63_318), _63_322) -> begin +| Some (FStar_Syntax_Syntax.Sig_new_effect_for_free (ne, _63_491), _63_495) -> begin Some (ne) end -| _63_326 -> begin +| _63_499 -> begin None end)) @@ -424,34 +780,34 @@ let is_effect_name : env -> FStar_Ident.lident -> Prims.bool = (fun env lid | None -> begin false end -| Some (_63_331) -> begin +| Some (_63_504) -> begin true end)) let lookup_letbinding_quals : env -> FStar_Ident.lident -> FStar_Syntax_Syntax.qualifier Prims.list = (fun env lid -> ( -let find_in_sig = (fun lid -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with -| Some (FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_339, _63_341, quals, _63_344), _63_348) -> begin +let k_global_def = (fun lid _63_14 -> (match (_63_14) with +| (FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_513, _63_515, quals, _63_518), _63_522) -> begin Some (quals) end -| _63_352 -> begin +| _63_525 -> begin None end)) -in (match ((resolve_in_open_namespaces env lid find_in_sig)) with +in (match ((resolve_in_open_namespaces' env lid (fun _63_528 -> None) (fun _63_526 -> None) k_global_def)) with | Some (quals) -> begin quals end -| _63_356 -> begin +| _63_533 -> begin [] end))) -let try_lookup_module : env -> Prims.string Prims.list -> FStar_Syntax_Syntax.modul Prims.option = (fun env path -> (match ((FStar_List.tryFind (fun _63_361 -> (match (_63_361) with +let try_lookup_module : env -> Prims.string Prims.list -> FStar_Syntax_Syntax.modul Prims.option = (fun env path -> (match ((FStar_List.tryFind (fun _63_538 -> (match (_63_538) with | (mlid, modul) -> begin ((FStar_Ident.path_of_lid mlid) = path) end)) env.modules)) with -| Some (_63_363, modul) -> begin +| Some (_63_540, modul) -> begin Some (modul) end | None -> begin @@ -461,43 +817,43 @@ end)) let try_lookup_let : env -> FStar_Ident.lident -> FStar_Syntax_Syntax.term Prims.option = (fun env lid -> ( -let find_in_sig = (fun lid -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with -| Some (FStar_Syntax_Syntax.Sig_let ((_63_373, lbs), _63_377, _63_379, _63_381), _63_385) -> begin +let k_global_def = (fun lid _63_15 -> (match (_63_15) with +| (FStar_Syntax_Syntax.Sig_let ((_63_551, lbs), _63_555, _63_557, _63_559), _63_563) -> begin ( let fv = (lb_fv lbs lid) -in (let _158_238 = (FStar_Syntax_Syntax.fvar lid fv.FStar_Syntax_Syntax.fv_delta fv.FStar_Syntax_Syntax.fv_qual) -in Some (_158_238))) +in (let _158_489 = (FStar_Syntax_Syntax.fvar lid fv.FStar_Syntax_Syntax.fv_delta fv.FStar_Syntax_Syntax.fv_qual) +in Some (_158_489))) end -| _63_390 -> begin +| _63_567 -> begin None end)) -in (resolve_in_open_namespaces env lid find_in_sig))) +in (resolve_in_open_namespaces' env lid (fun _63_570 -> None) (fun _63_568 -> None) k_global_def))) let try_lookup_definition : env -> FStar_Ident.lident -> FStar_Syntax_Syntax.term Prims.option = (fun env lid -> ( -let find_in_sig = (fun lid -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with -| Some (FStar_Syntax_Syntax.Sig_let (lbs, _63_397, _63_399, _63_401), _63_405) -> begin +let k_global_def = (fun lid _63_16 -> (match (_63_16) with +| (FStar_Syntax_Syntax.Sig_let (lbs, _63_579, _63_581, _63_583), _63_587) -> begin (FStar_Util.find_map (Prims.snd lbs) (fun lb -> (match (lb.FStar_Syntax_Syntax.lbname) with | FStar_Util.Inr (fv) when (FStar_Syntax_Syntax.fv_eq_lid fv lid) -> begin Some (lb.FStar_Syntax_Syntax.lbdef) end -| _63_412 -> begin +| _63_593 -> begin None end))) end -| _63_414 -> begin +| _63_595 -> begin None end)) -in (resolve_in_open_namespaces env lid find_in_sig))) +in (resolve_in_open_namespaces' env lid (fun _63_598 -> None) (fun _63_596 -> None) k_global_def))) let try_lookup_lid' : Prims.bool -> Prims.bool -> env -> FStar_Ident.lident -> (FStar_Syntax_Syntax.term * Prims.bool) Prims.option = (fun any_val exclude_interf env lid -> (match ((try_lookup_name any_val exclude_interf env lid)) with | Some (Term_name (e, mut)) -> begin Some (((e), (mut))) end -| _63_425 -> begin +| _63_610 -> begin None end)) @@ -507,41 +863,41 @@ let try_lookup_lid : env -> FStar_Ident.lident -> (FStar_Syntax_Syntax.term let try_lookup_datacon : env -> FStar_Ident.lident -> FStar_Syntax_Syntax.fv Prims.option = (fun env lid -> ( -let find_in_sig = (fun lid -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with -| Some (FStar_Syntax_Syntax.Sig_declare_typ (_63_433, _63_435, _63_437, quals, _63_440), _63_444) -> begin -if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_6 -> (match (_63_6) with +let k_global_def = (fun lid _63_18 -> (match (_63_18) with +| (FStar_Syntax_Syntax.Sig_declare_typ (_63_619, _63_621, _63_623, quals, _63_626), _63_630) -> begin +if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _63_17 -> (match (_63_17) with | FStar_Syntax_Syntax.Assumption -> begin true end -| _63_450 -> begin +| _63_635 -> begin false end)))) then begin -(let _158_265 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant None) -in Some (_158_265)) +(let _158_524 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant None) +in Some (_158_524)) end else begin None end end -| Some (FStar_Syntax_Syntax.Sig_datacon (_63_452), _63_455) -> begin -(let _158_266 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) -in Some (_158_266)) +| (FStar_Syntax_Syntax.Sig_datacon (_63_637), _63_640) -> begin +(let _158_525 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) +in Some (_158_525)) end -| _63_459 -> begin +| _63_643 -> begin None end)) -in (resolve_in_open_namespaces env lid find_in_sig))) +in (resolve_in_open_namespaces' env lid (fun _63_646 -> None) (fun _63_644 -> None) k_global_def))) let find_all_datacons : env -> FStar_Ident.lident -> FStar_Ident.lident Prims.list Prims.option = (fun env lid -> ( -let find_in_sig = (fun lid -> (match ((FStar_Util.smap_try_find (sigmap env) lid.FStar_Ident.str)) with -| Some (FStar_Syntax_Syntax.Sig_inductive_typ (_63_465, _63_467, _63_469, _63_471, _63_473, datas, _63_476, _63_478), _63_482) -> begin +let k_global_def = (fun lid _63_19 -> (match (_63_19) with +| (FStar_Syntax_Syntax.Sig_inductive_typ (_63_654, _63_656, _63_658, _63_660, _63_662, datas, _63_665, _63_667), _63_671) -> begin Some (datas) end -| _63_486 -> begin +| _63_674 -> begin None end)) -in (resolve_in_open_namespaces env lid find_in_sig))) +in (resolve_in_open_namespaces' env lid (fun _63_677 -> None) (fun _63_675 -> None) k_global_def))) let record_cache_aux : ((Prims.unit -> Prims.unit) * (Prims.unit -> Prims.unit) * (Prims.unit -> record_or_dc Prims.list) * (record_or_dc -> Prims.unit) * (Prims.unit -> Prims.unit)) = ( @@ -549,46 +905,46 @@ let record_cache_aux : ((Prims.unit -> Prims.unit) * (Prims.unit -> Prims.un let record_cache = (FStar_Util.mk_ref (([])::[])) in ( -let push = (fun _63_489 -> (match (()) with +let push = (fun _63_681 -> (match (()) with | () -> begin -(let _158_288 = (let _158_287 = (let _158_285 = (FStar_ST.read record_cache) -in (FStar_List.hd _158_285)) -in (let _158_286 = (FStar_ST.read record_cache) -in (_158_287)::_158_286)) -in (FStar_ST.op_Colon_Equals record_cache _158_288)) +(let _158_553 = (let _158_552 = (let _158_550 = (FStar_ST.read record_cache) +in (FStar_List.hd _158_550)) +in (let _158_551 = (FStar_ST.read record_cache) +in (_158_552)::_158_551)) +in (FStar_ST.op_Colon_Equals record_cache _158_553)) end)) in ( -let pop = (fun _63_491 -> (match (()) with +let pop = (fun _63_683 -> (match (()) with | () -> begin -(let _158_292 = (let _158_291 = (FStar_ST.read record_cache) -in (FStar_List.tl _158_291)) -in (FStar_ST.op_Colon_Equals record_cache _158_292)) +(let _158_557 = (let _158_556 = (FStar_ST.read record_cache) +in (FStar_List.tl _158_556)) +in (FStar_ST.op_Colon_Equals record_cache _158_557)) end)) in ( -let peek = (fun _63_493 -> (match (()) with +let peek = (fun _63_685 -> (match (()) with | () -> begin -(let _158_295 = (FStar_ST.read record_cache) -in (FStar_List.hd _158_295)) +(let _158_560 = (FStar_ST.read record_cache) +in (FStar_List.hd _158_560)) end)) in ( -let insert = (fun r -> (let _158_302 = (let _158_301 = (let _158_298 = (peek ()) -in (r)::_158_298) -in (let _158_300 = (let _158_299 = (FStar_ST.read record_cache) -in (FStar_List.tl _158_299)) -in (_158_301)::_158_300)) -in (FStar_ST.op_Colon_Equals record_cache _158_302))) +let insert = (fun r -> (let _158_567 = (let _158_566 = (let _158_563 = (peek ()) +in (r)::_158_563) +in (let _158_565 = (let _158_564 = (FStar_ST.read record_cache) +in (FStar_List.tl _158_564)) +in (_158_566)::_158_565)) +in (FStar_ST.op_Colon_Equals record_cache _158_567))) in ( -let commit = (fun _63_497 -> (match (()) with +let commit = (fun _63_689 -> (match (()) with | () -> begin (match ((FStar_ST.read record_cache)) with -| (hd)::(_63_500)::tl -> begin +| (hd)::(_63_692)::tl -> begin (FStar_ST.op_Colon_Equals record_cache ((hd)::tl)) end -| _63_505 -> begin +| _63_697 -> begin (FStar_All.failwith "Impossible") end) end)) @@ -597,172 +953,149 @@ in ((push), (pop), (peek), (insert), (commit)))))))) let push_record_cache : Prims.unit -> Prims.unit = ( -let _63_515 = record_cache_aux -in (match (_63_515) with -| (push, _63_508, _63_510, _63_512, _63_514) -> begin +let _63_707 = record_cache_aux +in (match (_63_707) with +| (push, _63_700, _63_702, _63_704, _63_706) -> begin push end)) let pop_record_cache : Prims.unit -> Prims.unit = ( -let _63_525 = record_cache_aux -in (match (_63_525) with -| (_63_517, pop, _63_520, _63_522, _63_524) -> begin +let _63_717 = record_cache_aux +in (match (_63_717) with +| (_63_709, pop, _63_712, _63_714, _63_716) -> begin pop end)) let peek_record_cache : Prims.unit -> record_or_dc Prims.list = ( -let _63_535 = record_cache_aux -in (match (_63_535) with -| (_63_527, _63_529, peek, _63_532, _63_534) -> begin +let _63_727 = record_cache_aux +in (match (_63_727) with +| (_63_719, _63_721, peek, _63_724, _63_726) -> begin peek end)) let insert_record_cache : record_or_dc -> Prims.unit = ( -let _63_545 = record_cache_aux -in (match (_63_545) with -| (_63_537, _63_539, _63_541, insert, _63_544) -> begin +let _63_737 = record_cache_aux +in (match (_63_737) with +| (_63_729, _63_731, _63_733, insert, _63_736) -> begin insert end)) let commit_record_cache : Prims.unit -> Prims.unit = ( -let _63_555 = record_cache_aux -in (match (_63_555) with -| (_63_547, _63_549, _63_551, _63_553, commit) -> begin +let _63_747 = record_cache_aux +in (match (_63_747) with +| (_63_739, _63_741, _63_743, _63_745, commit) -> begin commit end)) -let extract_record : env -> FStar_Syntax_Syntax.sigelt -> Prims.unit = (fun e _63_10 -> (match (_63_10) with -| FStar_Syntax_Syntax.Sig_bundle (sigs, _63_560, _63_562, _63_564) -> begin +let extract_record : env -> scope_mod Prims.list FStar_ST.ref -> FStar_Syntax_Syntax.sigelt -> Prims.unit = (fun e new_globs _63_23 -> (match (_63_23) with +| FStar_Syntax_Syntax.Sig_bundle (sigs, _63_753, _63_755, _63_757) -> begin ( -let is_rec = (FStar_Util.for_some (fun _63_7 -> (match (_63_7) with +let is_rec = (FStar_Util.for_some (fun _63_20 -> (match (_63_20) with | (FStar_Syntax_Syntax.RecordType (_)) | (FStar_Syntax_Syntax.RecordConstructor (_)) -> begin true end -| _63_575 -> begin +| _63_768 -> begin false end))) in ( -let find_dc = (fun dc -> (FStar_All.pipe_right sigs (FStar_Util.find_opt (fun _63_8 -> (match (_63_8) with -| FStar_Syntax_Syntax.Sig_datacon (lid, _63_582, _63_584, _63_586, _63_588, _63_590, _63_592, _63_594) -> begin +let find_dc = (fun dc -> (FStar_All.pipe_right sigs (FStar_Util.find_opt (fun _63_21 -> (match (_63_21) with +| FStar_Syntax_Syntax.Sig_datacon (lid, _63_775, _63_777, _63_779, _63_781, _63_783, _63_785, _63_787) -> begin (FStar_Ident.lid_equals dc lid) end -| _63_598 -> begin +| _63_791 -> begin false end))))) -in (FStar_All.pipe_right sigs (FStar_List.iter (fun _63_9 -> (match (_63_9) with -| FStar_Syntax_Syntax.Sig_inductive_typ (typename, univs, parms, _63_604, _63_606, (dc)::[], tags, _63_611) -> begin -(match ((let _158_405 = (find_dc dc) -in (FStar_All.pipe_left FStar_Util.must _158_405))) with -| FStar_Syntax_Syntax.Sig_datacon (constrname, _63_616, t, _63_619, _63_621, _63_623, _63_625, _63_627) -> begin +in (FStar_All.pipe_right sigs (FStar_List.iter (fun _63_22 -> (match (_63_22) with +| FStar_Syntax_Syntax.Sig_inductive_typ (typename, univs, parms, _63_797, _63_799, (dc)::[], tags, _63_804) -> begin +(match ((let _158_672 = (find_dc dc) +in (FStar_All.pipe_left FStar_Util.must _158_672))) with +| FStar_Syntax_Syntax.Sig_datacon (constrname, _63_809, t, _63_812, _63_814, _63_816, _63_818, _63_820) -> begin ( -let _63_633 = (FStar_Syntax_Util.arrow_formals t) -in (match (_63_633) with -| (formals, _63_632) -> begin +let _63_826 = (FStar_Syntax_Util.arrow_formals t) +in (match (_63_826) with +| (formals, _63_825) -> begin ( let is_rec = (is_rec tags) in ( -let fields = (FStar_All.pipe_right formals (FStar_List.collect (fun _63_637 -> (match (_63_637) with +let fields = (FStar_All.pipe_right formals (FStar_List.collect (fun _63_830 -> (match (_63_830) with | (x, q) -> begin if ((FStar_Syntax_Syntax.is_null_bv x) || (is_rec && (FStar_Syntax_Syntax.is_implicit q))) then begin [] end else begin -(let _158_409 = (let _158_408 = (let _158_407 = if is_rec then begin +(let _158_676 = (let _158_675 = (let _158_674 = if is_rec then begin (FStar_Syntax_Util.unmangle_field_name x.FStar_Syntax_Syntax.ppname) end else begin x.FStar_Syntax_Syntax.ppname end -in (qual constrname _158_407)) -in ((_158_408), (x.FStar_Syntax_Syntax.sort))) -in (_158_409)::[]) +in (FStar_Syntax_Util.mk_field_projector_name_from_ident constrname _158_674)) +in ((_158_675), (x.FStar_Syntax_Syntax.sort))) +in (_158_676)::[]) end end)))) in ( let record = {typename = typename; constrname = constrname; parms = parms; fields = fields; is_record = is_rec} -in (insert_record_cache record)))) +in ( + +let _63_833 = (let _158_678 = (let _158_677 = (FStar_ST.read new_globs) +in (Record_or_dc (record))::_158_677) +in (FStar_ST.op_Colon_Equals new_globs _158_678)) +in (match (()) with +| () -> begin +(insert_record_cache record) +end))))) end)) end -| _63_641 -> begin +| _63_835 -> begin () end) end -| _63_643 -> begin +| _63_837 -> begin () end)))))) end -| _63_645 -> begin +| _63_839 -> begin () end)) -let try_lookup_record_or_dc_by_field_name : env -> FStar_Ident.lident -> (record_or_dc * FStar_Ident.lident) Prims.option = (fun env fieldname -> ( - -let maybe_add_constrname = (fun ns c -> ( +let try_lookup_record_or_dc_by_field_name : env -> FStar_Ident.lident -> (record_or_dc * FStar_Syntax_Syntax.fieldname) Prims.option = (fun env fieldname -> ( -let rec aux = (fun ns -> (match (ns) with -| [] -> begin -(c)::[] -end -| (c')::[] -> begin -if (c'.FStar_Ident.idText = c.FStar_Ident.idText) then begin -(c)::[] -end else begin -(c')::(c)::[] -end -end -| (hd)::tl -> begin -(let _158_420 = (aux tl) -in (hd)::_158_420) -end)) -in (aux ns))) +let needs_constrname = (not ((FStar_Syntax_Util.field_projector_contains_constructor fieldname.FStar_Ident.ident.FStar_Ident.idText))) in ( let find_in_cache = (fun fieldname -> ( -let _63_663 = ((fieldname.FStar_Ident.ns), (fieldname.FStar_Ident.ident)) -in (match (_63_663) with -| (ns, fieldname) -> begin -(let _158_425 = (peek_record_cache ()) -in (FStar_Util.find_map _158_425 (fun record -> ( - -let constrname = record.constrname.FStar_Ident.ident -in ( - -let ns = (maybe_add_constrname ns constrname) -in ( - -let fname = (FStar_Ident.lid_of_ids (FStar_List.append ns ((fieldname)::[]))) -in (FStar_Util.find_map record.fields (fun _63_671 -> (match (_63_671) with -| (f, _63_670) -> begin -if (FStar_Ident.lid_equals fname f) then begin -Some (((record), (fname))) -end else begin -None -end -end))))))))) +let _63_847 = ((fieldname.FStar_Ident.ns), (fieldname.FStar_Ident.ident)) +in (match (_63_847) with +| (ns, id) -> begin +(let _158_689 = (peek_record_cache ()) +in (FStar_Util.find_map _158_689 (fun record -> (let _158_688 = (find_in_record ns id record (fun r -> Cont_ok (r))) +in (option_of_cont (fun _63_850 -> None) _158_688))))) end))) -in (resolve_in_open_namespaces env fieldname find_in_cache)))) +in (resolve_in_open_namespaces'' env fieldname (fun _63_860 -> Cont_ignore) (fun _63_858 -> Cont_ignore) (fun r -> Cont_ok (r)) (fun k fn -> (let _158_695 = (find_in_cache fn) +in (cont_of_option k _158_695))) (fun k _63_853 -> k))))) let try_lookup_record_by_field_name : env -> FStar_Ident.lident -> (record_or_dc * FStar_Ident.lident) Prims.option = (fun env fieldname -> (match ((try_lookup_record_or_dc_by_field_name env fieldname)) with | Some (r, f) when r.is_record -> begin Some (((r), (f))) end -| _63_679 -> begin +| _63_869 -> begin None end)) @@ -771,7 +1104,7 @@ let try_lookup_projector_by_field_name : env -> FStar_Ident.lident -> (FStar | Some (r, f) -> begin Some (((f), (r.is_record))) end -| _63_687 -> begin +| _63_877 -> begin None end)) @@ -780,17 +1113,18 @@ let qualify_field_to_record : env -> record_or_dc -> FStar_Ident.lident -> let qualify = (fun fieldname -> ( -let _63_695 = ((fieldname.FStar_Ident.ns), (fieldname.FStar_Ident.ident)) -in (match (_63_695) with +let _63_885 = ((fieldname.FStar_Ident.ns), (fieldname.FStar_Ident.ident)) +in (match (_63_885) with | (ns, fieldname) -> begin ( let constrname = recd.constrname.FStar_Ident.ident in ( -let fname = (FStar_Ident.lid_of_ids (FStar_List.append ns (FStar_List.append ((constrname)::[]) ((fieldname)::[])))) -in (FStar_Util.find_map recd.fields (fun _63_701 -> (match (_63_701) with -| (f, _63_700) -> begin +let fname = (let _158_714 = (FStar_Ident.lid_of_ids (FStar_List.append ns ((constrname)::[]))) +in (FStar_Syntax_Util.mk_field_projector_name_from_ident _158_714 fieldname)) +in (FStar_Util.find_map recd.fields (fun _63_891 -> (match (_63_891) with +| (f, _63_890) -> begin if (FStar_Ident.lid_equals fname f) then begin Some (fname) end else begin @@ -798,31 +1132,35 @@ None end end))))) end))) -in (resolve_in_open_namespaces env f qualify))) +in (resolve_in_open_namespaces'' env f (fun _63_900 -> Cont_ignore) (fun _63_898 -> Cont_ignore) (fun r -> Cont_ok ((Prims.snd r))) (fun k fn -> (let _158_721 = (qualify fn) +in (cont_of_option k _158_721))) (fun k _63_893 -> k)))) let unique : Prims.bool -> Prims.bool -> env -> FStar_Ident.lident -> Prims.bool = (fun any_val exclude_if env lid -> ( let this_env = ( -let _63_706 = env -in {curmodule = _63_706.curmodule; modules = _63_706.modules; open_namespaces = []; modul_abbrevs = _63_706.modul_abbrevs; sigaccum = _63_706.sigaccum; localbindings = _63_706.localbindings; recbindings = _63_706.recbindings; sigmap = _63_706.sigmap; default_result_effect = _63_706.default_result_effect; iface = _63_706.iface; admitted_iface = _63_706.admitted_iface; expect_typ = _63_706.expect_typ}) +let _63_906 = env +in {curmodule = _63_906.curmodule; curmonad = _63_906.curmonad; modules = _63_906.modules; scope_mods = []; sigaccum = _63_906.sigaccum; sigmap = _63_906.sigmap; default_result_effect = _63_906.default_result_effect; iface = _63_906.iface; admitted_iface = _63_906.admitted_iface; expect_typ = _63_906.expect_typ}) in (match ((try_lookup_lid' any_val exclude_if env lid)) with | None -> begin true end -| Some (_63_711) -> begin +| Some (_63_911) -> begin false end))) +let push_scope_mod : env -> scope_mod -> env = (fun env scope_mod -> ( + +let _63_915 = env +in {curmodule = _63_915.curmodule; curmonad = _63_915.curmonad; modules = _63_915.modules; scope_mods = (scope_mod)::env.scope_mods; sigaccum = _63_915.sigaccum; sigmap = _63_915.sigmap; default_result_effect = _63_915.default_result_effect; iface = _63_915.iface; admitted_iface = _63_915.admitted_iface; expect_typ = _63_915.expect_typ})) + + let push_bv' : env -> FStar_Ident.ident -> Prims.bool -> (env * FStar_Syntax_Syntax.bv) = (fun env x is_mutable -> ( let bv = (FStar_Syntax_Syntax.gen_bv x.FStar_Ident.idText (Some (x.FStar_Ident.idRange)) FStar_Syntax_Syntax.tun) -in ((( - -let _63_717 = env -in {curmodule = _63_717.curmodule; modules = _63_717.modules; open_namespaces = _63_717.open_namespaces; modul_abbrevs = _63_717.modul_abbrevs; sigaccum = _63_717.sigaccum; localbindings = (((x), (bv), (is_mutable)))::env.localbindings; recbindings = _63_717.recbindings; sigmap = _63_717.sigmap; default_result_effect = _63_717.default_result_effect; iface = _63_717.iface; admitted_iface = _63_717.admitted_iface; expect_typ = _63_717.expect_typ})), (bv)))) +in (((push_scope_mod env (Local_binding (((x), (bv), (is_mutable)))))), (bv)))) let push_bv_mutable : env -> FStar_Ident.ident -> (env * FStar_Syntax_Syntax.bv) = (fun env x -> (push_bv' env x true)) @@ -835,10 +1173,7 @@ let push_top_level_rec_binding : env -> FStar_Ident.ident -> FStar_Syntax_Sy let l = (qualify env x) in if (unique false true env l) then begin -( - -let _63_727 = env -in {curmodule = _63_727.curmodule; modules = _63_727.modules; open_namespaces = _63_727.open_namespaces; modul_abbrevs = _63_727.modul_abbrevs; sigaccum = _63_727.sigaccum; localbindings = _63_727.localbindings; recbindings = (((x), (l), (dd)))::env.recbindings; sigmap = _63_727.sigmap; default_result_effect = _63_727.default_result_effect; iface = _63_727.iface; admitted_iface = _63_727.admitted_iface; expect_typ = _63_727.expect_typ}) +(push_scope_mod env (Rec_binding (((x), (l), (dd))))) end else begin (Prims.raise (FStar_Syntax_Syntax.Error ((((Prims.strcat "Duplicate top-level names " l.FStar_Ident.str)), ((FStar_Ident.range_of_lid l)))))) end)) @@ -852,9 +1187,9 @@ let sopt = (FStar_Util.smap_try_find (sigmap env) l.FStar_Ident.str) in ( let r = (match (sopt) with -| Some (se, _63_736) -> begin -(match ((let _158_477 = (FStar_Syntax_Util.lids_of_sigelt se) -in (FStar_Util.find_opt (FStar_Ident.lid_equals l) _158_477))) with +| Some (se, _63_936) -> begin +(match ((let _158_762 = (FStar_Syntax_Util.lids_of_sigelt se) +in (FStar_Util.find_opt (FStar_Ident.lid_equals l) _158_762))) with | Some (l) -> begin (FStar_All.pipe_left FStar_Range.string_of_range (FStar_Ident.range_of_lid l)) end @@ -865,25 +1200,28 @@ end | None -> begin "" end) -in (let _158_480 = (let _158_479 = (let _158_478 = (FStar_Util.format2 "Duplicate top-level names [%s]; previously declared at %s" (FStar_Ident.text_of_lid l) r) -in ((_158_478), ((FStar_Ident.range_of_lid l)))) -in FStar_Syntax_Syntax.Error (_158_479)) -in (Prims.raise _158_480))))) +in (let _158_765 = (let _158_764 = (let _158_763 = (FStar_Util.format2 "Duplicate top-level names [%s]; previously declared at %s" (FStar_Ident.text_of_lid l) r) +in ((_158_763), ((FStar_Ident.range_of_lid l)))) +in FStar_Syntax_Syntax.Error (_158_764)) +in (Prims.raise _158_765))))) +in ( + +let globals = (FStar_ST.alloc env.scope_mods) in ( let env = ( -let _63_754 = (match (s) with -| FStar_Syntax_Syntax.Sig_let (_63_745) -> begin +let _63_955 = (match (s) with +| FStar_Syntax_Syntax.Sig_let (_63_946) -> begin ((false), (true)) end -| FStar_Syntax_Syntax.Sig_bundle (_63_748) -> begin +| FStar_Syntax_Syntax.Sig_bundle (_63_949) -> begin ((true), (true)) end -| _63_751 -> begin +| _63_952 -> begin ((false), (false)) end) -in (match (_63_754) with +in (match (_63_955) with | (any_val, exclude_if) -> begin ( @@ -896,11 +1234,11 @@ end))) with | None -> begin ( -let _63_758 = (extract_record env s) +let _63_959 = (extract_record env globals s) in ( -let _63_760 = env -in {curmodule = _63_760.curmodule; modules = _63_760.modules; open_namespaces = _63_760.open_namespaces; modul_abbrevs = _63_760.modul_abbrevs; sigaccum = (s)::env.sigaccum; localbindings = _63_760.localbindings; recbindings = _63_760.recbindings; sigmap = _63_760.sigmap; default_result_effect = _63_760.default_result_effect; iface = _63_760.iface; admitted_iface = _63_760.admitted_iface; expect_typ = _63_760.expect_typ})) +let _63_961 = env +in {curmodule = _63_961.curmodule; curmonad = _63_961.curmonad; modules = _63_961.modules; scope_mods = _63_961.scope_mods; sigaccum = (s)::env.sigaccum; sigmap = _63_961.sigmap; default_result_effect = _63_961.default_result_effect; iface = _63_961.iface; admitted_iface = _63_961.admitted_iface; expect_typ = _63_961.expect_typ})) end | Some (l) -> begin (err l) @@ -908,75 +1246,87 @@ end)) end)) in ( -let _63_779 = (match (s) with -| FStar_Syntax_Syntax.Sig_bundle (ses, _63_767, _63_769, _63_771) -> begin -(let _158_484 = (FStar_List.map (fun se -> (let _158_483 = (FStar_Syntax_Util.lids_of_sigelt se) -in ((_158_483), (se)))) ses) -in ((env), (_158_484))) -end -| _63_776 -> begin -(let _158_487 = (let _158_486 = (let _158_485 = (FStar_Syntax_Util.lids_of_sigelt s) -in ((_158_485), (s))) -in (_158_486)::[]) -in ((env), (_158_487))) +let env = ( + +let _63_966 = env +in (let _158_767 = (FStar_ST.read globals) +in {curmodule = _63_966.curmodule; curmonad = _63_966.curmonad; modules = _63_966.modules; scope_mods = _158_767; sigaccum = _63_966.sigaccum; sigmap = _63_966.sigmap; default_result_effect = _63_966.default_result_effect; iface = _63_966.iface; admitted_iface = _63_966.admitted_iface; expect_typ = _63_966.expect_typ})) +in ( + +let _63_983 = (match (s) with +| FStar_Syntax_Syntax.Sig_bundle (ses, _63_971, _63_973, _63_975) -> begin +(let _158_770 = (FStar_List.map (fun se -> (let _158_769 = (FStar_Syntax_Util.lids_of_sigelt se) +in ((_158_769), (se)))) ses) +in ((env), (_158_770))) +end +| _63_980 -> begin +(let _158_773 = (let _158_772 = (let _158_771 = (FStar_Syntax_Util.lids_of_sigelt s) +in ((_158_771), (s))) +in (_158_772)::[]) +in ((env), (_158_773))) end) -in (match (_63_779) with +in (match (_63_983) with | (env, lss) -> begin ( -let _63_784 = (FStar_All.pipe_right lss (FStar_List.iter (fun _63_782 -> (match (_63_782) with +let _63_989 = (FStar_All.pipe_right lss (FStar_List.iter (fun _63_986 -> (match (_63_986) with | (lids, se) -> begin -(FStar_All.pipe_right lids (FStar_List.iter (fun lid -> (FStar_Util.smap_add (sigmap env) lid.FStar_Ident.str ((se), ((env.iface && (not (env.admitted_iface))))))))) -end)))) -in env) -end))))) +(FStar_All.pipe_right lids (FStar_List.iter (fun lid -> ( +let _63_988 = (let _158_777 = (let _158_776 = (FStar_ST.read globals) +in (Top_level_def (lid.FStar_Ident.ident))::_158_776) +in (FStar_ST.op_Colon_Equals globals _158_777)) +in (match (()) with +| () -> begin +(FStar_Util.smap_add (sigmap env) lid.FStar_Ident.str ((se), ((env.iface && (not (env.admitted_iface)))))) +end))))) +end)))) +in ( -let push_namespace : env -> FStar_Ident.lident -> env = (fun env ns -> ( +let env = ( -let modules = env.modules -in if (FStar_All.pipe_right modules (FStar_Util.for_some (fun _63_792 -> (match (_63_792) with -| (m, _63_791) -> begin -(FStar_Util.starts_with (FStar_Ident.text_of_lid m) (FStar_Ident.text_of_lid ns)) -end)))) then begin -( +let _63_991 = env +in (let _158_778 = (FStar_ST.read globals) +in {curmodule = _63_991.curmodule; curmonad = _63_991.curmonad; modules = _63_991.modules; scope_mods = _158_778; sigaccum = _63_991.sigaccum; sigmap = _63_991.sigmap; default_result_effect = _63_991.default_result_effect; iface = _63_991.iface; admitted_iface = _63_991.admitted_iface; expect_typ = _63_991.expect_typ})) +in env)) +end))))))) -let _63_793 = env -in {curmodule = _63_793.curmodule; modules = _63_793.modules; open_namespaces = (ns)::env.open_namespaces; modul_abbrevs = _63_793.modul_abbrevs; sigaccum = _63_793.sigaccum; localbindings = _63_793.localbindings; recbindings = _63_793.recbindings; sigmap = _63_793.sigmap; default_result_effect = _63_793.default_result_effect; iface = _63_793.iface; admitted_iface = _63_793.admitted_iface; expect_typ = _63_793.expect_typ}) -end else begin -(let _158_497 = (let _158_496 = (let _158_495 = (FStar_Util.format1 "Namespace %s cannot be found" (FStar_Ident.text_of_lid ns)) -in ((_158_495), ((FStar_Ident.range_of_lid ns)))) -in FStar_Syntax_Syntax.Error (_158_496)) -in (Prims.raise _158_497)) -end)) +let push_namespace : env -> FStar_Ident.lident -> env = (fun env ns -> ( -let push_module_abbrev : env -> FStar_Ident.ident -> FStar_Ident.lident -> env = (fun env x l -> if (FStar_All.pipe_right env.modul_abbrevs (FStar_Util.for_some (fun _63_801 -> (match (_63_801) with -| (y, _63_800) -> begin -(x.FStar_Ident.idText = y.FStar_Ident.idText) -end)))) then begin -(let _158_507 = (let _158_506 = (let _158_505 = (FStar_Util.format1 "Module %s is already defined" x.FStar_Ident.idText) -in ((_158_505), (x.FStar_Ident.idRange))) -in FStar_Syntax_Syntax.Error (_158_506)) -in (Prims.raise _158_507)) -end else begin +let _63_1006 = (match ((resolve_module_name env ns false)) with +| None -> begin ( let modules = env.modules -in if (FStar_All.pipe_right modules (FStar_Util.for_some (fun _63_806 -> (match (_63_806) with -| (m, _63_805) -> begin -(FStar_Ident.lid_equals m l) +in if (FStar_All.pipe_right modules (FStar_Util.for_some (fun _63_1001 -> (match (_63_1001) with +| (m, _63_1000) -> begin +(FStar_Util.starts_with (Prims.strcat (FStar_Ident.text_of_lid m) ".") (Prims.strcat (FStar_Ident.text_of_lid ns) ".")) end)))) then begin -( - -let _63_807 = env -in {curmodule = _63_807.curmodule; modules = _63_807.modules; open_namespaces = _63_807.open_namespaces; modul_abbrevs = (((x), (l)))::env.modul_abbrevs; sigaccum = _63_807.sigaccum; localbindings = _63_807.localbindings; recbindings = _63_807.recbindings; sigmap = _63_807.sigmap; default_result_effect = _63_807.default_result_effect; iface = _63_807.iface; admitted_iface = _63_807.admitted_iface; expect_typ = _63_807.expect_typ}) +((ns), (Open_namespace)) end else begin -(let _158_511 = (let _158_510 = (let _158_509 = (FStar_Util.format1 "Module %s cannot be found" (FStar_Ident.text_of_lid l)) -in ((_158_509), ((FStar_Ident.range_of_lid l)))) -in FStar_Syntax_Syntax.Error (_158_510)) -in (Prims.raise _158_511)) +(let _158_786 = (let _158_785 = (let _158_784 = (FStar_Util.format1 "Namespace %s cannot be found" (FStar_Ident.text_of_lid ns)) +in ((_158_784), ((FStar_Ident.range_of_lid ns)))) +in FStar_Syntax_Syntax.Error (_158_785)) +in (Prims.raise _158_786)) end) +end +| Some (ns') -> begin +((ns'), (Open_module)) +end) +in (match (_63_1006) with +| (ns', kd) -> begin +(push_scope_mod env (Open_module_or_namespace (((ns'), (kd))))) +end))) + + +let push_module_abbrev : env -> FStar_Ident.ident -> FStar_Ident.lident -> env = (fun env x l -> if (module_is_defined env l) then begin +(push_scope_mod env (Module_abbrev (((x), (l))))) +end else begin +(let _158_795 = (let _158_794 = (let _158_793 = (FStar_Util.format1 "Module %s cannot be found" (FStar_Ident.text_of_lid l)) +in ((_158_793), ((FStar_Ident.range_of_lid l)))) +in FStar_Syntax_Syntax.Error (_158_794)) +in (Prims.raise _158_795)) end) @@ -986,62 +1336,62 @@ let check_admits : env -> Prims.unit = (fun env -> (FStar_All.pipe_right env.s | None -> begin ( -let _63_819 = (let _158_517 = (let _158_516 = (FStar_Range.string_of_range (FStar_Ident.range_of_lid l)) -in (let _158_515 = (FStar_Syntax_Print.lid_to_string l) -in (FStar_Util.format2 "%s: Warning: Admitting %s without a definition\n" _158_516 _158_515))) -in (FStar_Util.print_string _158_517)) +let _63_1020 = (let _158_801 = (let _158_800 = (FStar_Range.string_of_range (FStar_Ident.range_of_lid l)) +in (let _158_799 = (FStar_Syntax_Print.lid_to_string l) +in (FStar_Util.format2 "%s: Warning: Admitting %s without a definition\n" _158_800 _158_799))) +in (FStar_Util.print_string _158_801)) in (FStar_Util.smap_add (sigmap env) l.FStar_Ident.str ((FStar_Syntax_Syntax.Sig_declare_typ (((l), (u), (t), ((FStar_Syntax_Syntax.Assumption)::quals), (r)))), (false)))) end -| Some (_63_822) -> begin +| Some (_63_1023) -> begin () end) end -| _63_825 -> begin +| _63_1026 -> begin () end))))) let finish : env -> FStar_Syntax_Syntax.modul -> env = (fun env modul -> ( -let _63_885 = (FStar_All.pipe_right modul.FStar_Syntax_Syntax.declarations (FStar_List.iter (fun _63_12 -> (match (_63_12) with -| FStar_Syntax_Syntax.Sig_bundle (ses, quals, _63_832, _63_834) -> begin +let _63_1086 = (FStar_All.pipe_right modul.FStar_Syntax_Syntax.declarations (FStar_List.iter (fun _63_25 -> (match (_63_25) with +| FStar_Syntax_Syntax.Sig_bundle (ses, quals, _63_1033, _63_1035) -> begin if ((FStar_List.contains FStar_Syntax_Syntax.Private quals) || (FStar_List.contains FStar_Syntax_Syntax.Abstract quals)) then begin -(FStar_All.pipe_right ses (FStar_List.iter (fun _63_11 -> (match (_63_11) with -| FStar_Syntax_Syntax.Sig_datacon (lid, _63_840, _63_842, _63_844, _63_846, _63_848, _63_850, _63_852) -> begin +(FStar_All.pipe_right ses (FStar_List.iter (fun _63_24 -> (match (_63_24) with +| FStar_Syntax_Syntax.Sig_datacon (lid, _63_1041, _63_1043, _63_1045, _63_1047, _63_1049, _63_1051, _63_1053) -> begin (FStar_Util.smap_remove (sigmap env) lid.FStar_Ident.str) end -| _63_856 -> begin +| _63_1057 -> begin () end)))) end else begin () end end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_859, _63_861, quals, _63_864) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (lid, _63_1060, _63_1062, quals, _63_1065) -> begin if (FStar_List.contains FStar_Syntax_Syntax.Private quals) then begin (FStar_Util.smap_remove (sigmap env) lid.FStar_Ident.str) end else begin () end end -| FStar_Syntax_Syntax.Sig_let ((_63_868, lbs), r, _63_873, quals) -> begin +| FStar_Syntax_Syntax.Sig_let ((_63_1069, lbs), r, _63_1074, quals) -> begin ( -let _63_878 = if ((FStar_List.contains FStar_Syntax_Syntax.Private quals) || (FStar_List.contains FStar_Syntax_Syntax.Abstract quals)) then begin -(FStar_All.pipe_right lbs (FStar_List.iter (fun lb -> (let _158_528 = (let _158_527 = (let _158_526 = (let _158_525 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) -in _158_525.FStar_Syntax_Syntax.fv_name) -in _158_526.FStar_Syntax_Syntax.v) -in _158_527.FStar_Ident.str) -in (FStar_Util.smap_remove (sigmap env) _158_528))))) +let _63_1079 = if ((FStar_List.contains FStar_Syntax_Syntax.Private quals) || (FStar_List.contains FStar_Syntax_Syntax.Abstract quals)) then begin +(FStar_All.pipe_right lbs (FStar_List.iter (fun lb -> (let _158_812 = (let _158_811 = (let _158_810 = (let _158_809 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) +in _158_809.FStar_Syntax_Syntax.fv_name) +in _158_810.FStar_Syntax_Syntax.v) +in _158_811.FStar_Ident.str) +in (FStar_Util.smap_remove (sigmap env) _158_812))))) end else begin () end in if ((FStar_List.contains FStar_Syntax_Syntax.Abstract quals) && (not ((FStar_List.contains FStar_Syntax_Syntax.Private quals)))) then begin (FStar_All.pipe_right lbs (FStar_List.iter (fun lb -> ( -let lid = (let _158_531 = (let _158_530 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) -in _158_530.FStar_Syntax_Syntax.fv_name) -in _158_531.FStar_Syntax_Syntax.v) +let lid = (let _158_815 = (let _158_814 = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) +in _158_814.FStar_Syntax_Syntax.fv_name) +in _158_815.FStar_Syntax_Syntax.v) in ( let decl = FStar_Syntax_Syntax.Sig_declare_typ (((lid), (lb.FStar_Syntax_Syntax.lbunivs), (lb.FStar_Syntax_Syntax.lbtyp), ((FStar_Syntax_Syntax.Assumption)::quals), (r))) @@ -1050,13 +1400,13 @@ end else begin () end) end -| _63_884 -> begin +| _63_1085 -> begin () end)))) in ( -let _63_887 = env -in {curmodule = None; modules = (((modul.FStar_Syntax_Syntax.name), (modul)))::env.modules; open_namespaces = []; modul_abbrevs = []; sigaccum = []; localbindings = []; recbindings = []; sigmap = _63_887.sigmap; default_result_effect = _63_887.default_result_effect; iface = _63_887.iface; admitted_iface = _63_887.admitted_iface; expect_typ = _63_887.expect_typ}))) +let _63_1088 = env +in {curmodule = None; curmonad = _63_1088.curmonad; modules = (((modul.FStar_Syntax_Syntax.name), (modul)))::env.modules; scope_mods = []; sigaccum = []; sigmap = _63_1088.sigmap; default_result_effect = _63_1088.default_result_effect; iface = _63_1088.iface; admitted_iface = _63_1088.admitted_iface; expect_typ = _63_1088.expect_typ}))) type env_stack_ops = @@ -1073,45 +1423,45 @@ in ( let push = (fun env -> ( -let _63_898 = (push_record_cache ()) +let _63_1099 = (push_record_cache ()) in ( -let _63_900 = (let _158_581 = (let _158_580 = (FStar_ST.read stack) -in (env)::_158_580) -in (FStar_ST.op_Colon_Equals stack _158_581)) +let _63_1101 = (let _158_865 = (let _158_864 = (FStar_ST.read stack) +in (env)::_158_864) +in (FStar_ST.op_Colon_Equals stack _158_865)) in ( -let _63_902 = env -in (let _158_582 = (FStar_Util.smap_copy (sigmap env)) -in {curmodule = _63_902.curmodule; modules = _63_902.modules; open_namespaces = _63_902.open_namespaces; modul_abbrevs = _63_902.modul_abbrevs; sigaccum = _63_902.sigaccum; localbindings = _63_902.localbindings; recbindings = _63_902.recbindings; sigmap = _158_582; default_result_effect = _63_902.default_result_effect; iface = _63_902.iface; admitted_iface = _63_902.admitted_iface; expect_typ = _63_902.expect_typ}))))) +let _63_1103 = env +in (let _158_866 = (FStar_Util.smap_copy (sigmap env)) +in {curmodule = _63_1103.curmodule; curmonad = _63_1103.curmonad; modules = _63_1103.modules; scope_mods = _63_1103.scope_mods; sigaccum = _63_1103.sigaccum; sigmap = _158_866; default_result_effect = _63_1103.default_result_effect; iface = _63_1103.iface; admitted_iface = _63_1103.admitted_iface; expect_typ = _63_1103.expect_typ}))))) in ( let pop = (fun env -> (match ((FStar_ST.read stack)) with | (env)::tl -> begin ( -let _63_909 = (pop_record_cache ()) +let _63_1110 = (pop_record_cache ()) in ( -let _63_911 = (FStar_ST.op_Colon_Equals stack tl) +let _63_1112 = (FStar_ST.op_Colon_Equals stack tl) in env)) end -| _63_914 -> begin +| _63_1115 -> begin (FStar_All.failwith "Impossible: Too many pops") end)) in ( let commit_mark = (fun env -> ( -let _63_917 = (commit_record_cache ()) +let _63_1118 = (commit_record_cache ()) in (match ((FStar_ST.read stack)) with -| (_63_921)::tl -> begin +| (_63_1122)::tl -> begin ( -let _63_923 = (FStar_ST.op_Colon_Equals stack tl) +let _63_1124 = (FStar_ST.op_Colon_Equals stack tl) in env) end -| _63_926 -> begin +| _63_1127 -> begin (FStar_All.failwith "Impossible: Too many pops") end))) in {push = push; mark = push; reset_mark = pop; commit_mark = commit_mark; pop = pop})))) @@ -1135,10 +1485,10 @@ let pop : env -> env = (fun env -> (stack_ops.pop env)) let export_interface : FStar_Ident.lident -> env -> env = (fun m env -> ( let sigelt_in_m = (fun se -> (match ((FStar_Syntax_Util.lids_of_sigelt se)) with -| (l)::_63_937 -> begin +| (l)::_63_1138 -> begin (l.FStar_Ident.nsstr = m.FStar_Ident.str) end -| _63_941 -> begin +| _63_1142 -> begin false end)) in ( @@ -1155,23 +1505,23 @@ in ( let sm' = (sigmap env) in ( -let _63_965 = (FStar_All.pipe_right keys (FStar_List.iter (fun k -> (match ((FStar_Util.smap_try_find sm' k)) with +let _63_1166 = (FStar_All.pipe_right keys (FStar_List.iter (fun k -> (match ((FStar_Util.smap_try_find sm' k)) with | Some (se, true) when (sigelt_in_m se) -> begin ( -let _63_951 = (FStar_Util.smap_remove sm' k) +let _63_1152 = (FStar_Util.smap_remove sm' k) in ( let se = (match (se) with | FStar_Syntax_Syntax.Sig_declare_typ (l, u, t, q, r) -> begin FStar_Syntax_Syntax.Sig_declare_typ (((l), (u), (t), ((FStar_Syntax_Syntax.Assumption)::q), (r))) end -| _63_961 -> begin +| _63_1162 -> begin se end) in (FStar_Util.smap_add sm' k ((se), (false))))) end -| _63_964 -> begin +| _63_1165 -> begin () end)))) in env))))))) @@ -1179,7 +1529,7 @@ in env))))))) let finish_module_or_interface : env -> FStar_Syntax_Syntax.modul -> env = (fun env modul -> ( -let _63_969 = if (not (modul.FStar_Syntax_Syntax.is_interface)) then begin +let _63_1170 = if (not (modul.FStar_Syntax_Syntax.is_interface)) then begin (check_admits env) end else begin () @@ -1212,87 +1562,88 @@ open_ns end in ( -let _63_980 = env -in {curmodule = Some (mname); modules = _63_980.modules; open_namespaces = open_ns; modul_abbrevs = _63_980.modul_abbrevs; sigaccum = _63_980.sigaccum; localbindings = _63_980.localbindings; recbindings = _63_980.recbindings; sigmap = env.sigmap; default_result_effect = if ((FStar_Ident.lid_equals mname FStar_Syntax_Const.all_lid) || (has_all_in_scope env)) then begin +let _63_1181 = env +in (let _158_903 = (FStar_List.map (fun lid -> Open_module_or_namespace (((lid), (Open_namespace)))) open_ns) +in {curmodule = Some (mname); curmonad = _63_1181.curmonad; modules = _63_1181.modules; scope_mods = _158_903; sigaccum = _63_1181.sigaccum; sigmap = env.sigmap; default_result_effect = if ((FStar_Ident.lid_equals mname FStar_Syntax_Const.all_lid) || (has_all_in_scope env)) then begin FStar_Syntax_Const.effect_ML_lid end else begin FStar_Syntax_Const.effect_Tot_lid -end; iface = intf; admitted_iface = admitted; expect_typ = _63_980.expect_typ})))) -in (match ((FStar_All.pipe_right env.modules (FStar_Util.find_opt (fun _63_985 -> (match (_63_985) with -| (l, _63_984) -> begin +end; iface = intf; admitted_iface = admitted; expect_typ = _63_1181.expect_typ}))))) +in (match ((FStar_All.pipe_right env.modules (FStar_Util.find_opt (fun _63_1187 -> (match (_63_1187) with +| (l, _63_1186) -> begin (FStar_Ident.lid_equals l mname) end))))) with | None -> begin -(let _158_619 = (prep env) -in ((_158_619), (false))) +(let _158_905 = (prep env) +in ((_158_905), (false))) end -| Some (_63_988, m) -> begin +| Some (_63_1190, m) -> begin ( -let _63_992 = if ((not (m.FStar_Syntax_Syntax.is_interface)) || intf) then begin -(let _158_622 = (let _158_621 = (let _158_620 = (FStar_Util.format1 "Duplicate module or interface name: %s" mname.FStar_Ident.str) -in ((_158_620), ((FStar_Ident.range_of_lid mname)))) -in FStar_Syntax_Syntax.Error (_158_621)) -in (Prims.raise _158_622)) +let _63_1194 = if ((not (m.FStar_Syntax_Syntax.is_interface)) || intf) then begin +(let _158_908 = (let _158_907 = (let _158_906 = (FStar_Util.format1 "Duplicate module or interface name: %s" mname.FStar_Ident.str) +in ((_158_906), ((FStar_Ident.range_of_lid mname)))) +in FStar_Syntax_Syntax.Error (_158_907)) +in (Prims.raise _158_908)) end else begin () end -in (let _158_624 = (let _158_623 = (push env) -in (prep _158_623)) -in ((_158_624), (true)))) +in (let _158_910 = (let _158_909 = (push env) +in (prep _158_909)) +in ((_158_910), (true)))) end))) -let enter_monad_scope : env -> FStar_Ident.ident -> env = (fun env mname -> ( - -let curmod = (current_module env) -in ( - -let mscope = (FStar_Ident.lid_of_ids (FStar_List.append curmod.FStar_Ident.ns ((curmod.FStar_Ident.ident)::(mname)::[]))) -in ( - -let _63_998 = env -in {curmodule = Some (mscope); modules = _63_998.modules; open_namespaces = (curmod)::env.open_namespaces; modul_abbrevs = _63_998.modul_abbrevs; sigaccum = _63_998.sigaccum; localbindings = _63_998.localbindings; recbindings = _63_998.recbindings; sigmap = _63_998.sigmap; default_result_effect = _63_998.default_result_effect; iface = _63_998.iface; admitted_iface = _63_998.admitted_iface; expect_typ = _63_998.expect_typ})))) - - -let exit_monad_scope : env -> env -> env = (fun env0 env -> ( +let enter_monad_scope : env -> FStar_Ident.ident -> env = (fun env mname -> (match (env.curmonad) with +| Some (mname') -> begin +(Prims.raise (FStar_Syntax_Syntax.Error ((((Prims.strcat "Trying to define monad " (Prims.strcat mname.FStar_Ident.idText (Prims.strcat ", but already in monad scope " mname'.FStar_Ident.idText)))), (mname.FStar_Ident.idRange))))) +end +| None -> begin +( -let _63_1002 = env -in {curmodule = env0.curmodule; modules = _63_1002.modules; open_namespaces = env0.open_namespaces; modul_abbrevs = _63_1002.modul_abbrevs; sigaccum = _63_1002.sigaccum; localbindings = _63_1002.localbindings; recbindings = _63_1002.recbindings; sigmap = _63_1002.sigmap; default_result_effect = _63_1002.default_result_effect; iface = _63_1002.iface; admitted_iface = _63_1002.admitted_iface; expect_typ = _63_1002.expect_typ})) +let _63_1201 = env +in {curmodule = _63_1201.curmodule; curmonad = Some (mname); modules = _63_1201.modules; scope_mods = _63_1201.scope_mods; sigaccum = _63_1201.sigaccum; sigmap = _63_1201.sigmap; default_result_effect = _63_1201.default_result_effect; iface = _63_1201.iface; admitted_iface = _63_1201.admitted_iface; expect_typ = _63_1201.expect_typ}) +end)) let fail_or = (fun env lookup lid -> (match ((lookup lid)) with | None -> begin ( -let opened_modules = (FStar_List.map (fun _63_1011 -> (match (_63_1011) with -| (lid, _63_1010) -> begin +let opened_modules = (FStar_List.map (fun _63_1210 -> (match (_63_1210) with +| (lid, _63_1209) -> begin (FStar_Ident.text_of_lid lid) end)) env.modules) in ( -let module_of_the_lid = (let _158_640 = (FStar_Ident.path_of_ns lid.FStar_Ident.ns) -in (FStar_Ident.text_of_path _158_640)) -in ( - let msg = (FStar_Util.format1 "Identifier not found: [%s]" (FStar_Ident.text_of_lid lid)) in ( -let msg = (match (env.curmodule) with -| Some (m) when (((FStar_Ident.text_of_lid m) = module_of_the_lid) || (module_of_the_lid = "")) -> begin +let msg = if ((FStar_List.length lid.FStar_Ident.ns) = (Prims.parse_int "0")) then begin msg +end else begin +( + +let modul = (let _158_922 = (FStar_Ident.lid_of_ids lid.FStar_Ident.ns) +in (FStar_Ident.set_lid_range _158_922 (FStar_Ident.range_of_lid lid))) +in (match ((resolve_module_name env modul true)) with +| None -> begin +( + +let opened_modules = (FStar_String.concat ", " opened_modules) +in (FStar_Util.format3 "%s\nModule %s does not belong to the list of modules in scope, namely %s" msg modul.FStar_Ident.str opened_modules)) end -| _63_1018 when (FStar_List.existsb (fun m -> (m = module_of_the_lid)) opened_modules) -> begin -msg +| Some (modul') when (not ((FStar_List.existsb (fun m -> (m = modul'.FStar_Ident.str)) opened_modules))) -> begin +( + +let opened_modules = (FStar_String.concat ", " opened_modules) +in (FStar_Util.format4 "%s\nModule %s resolved into %s, which does not belong to the list of modules in scope, namely %s" msg modul.FStar_Ident.str modul'.FStar_Ident.str opened_modules)) end -| _63_1021 -> begin -(let _158_645 = (let _158_644 = (let _158_643 = (let _158_642 = (FStar_Ident.path_of_ns lid.FStar_Ident.ns) -in (FStar_Ident.text_of_path _158_642)) -in (FStar_Util.format3 "Hint: %s belongs to module %s, which does not belong to the list of modules in scope, namely %s" (FStar_Ident.text_of_lid lid) _158_643 (FStar_String.concat ", " opened_modules))) -in (Prims.strcat "\n" _158_644)) -in (Prims.strcat msg _158_645)) -end) -in (Prims.raise (FStar_Syntax_Syntax.Error (((msg), ((FStar_Ident.range_of_lid lid)))))))))) +| Some (modul') -> begin +(FStar_Util.format4 "%s\nModule %s resolved into %s, definition %s not found" msg modul.FStar_Ident.str modul'.FStar_Ident.str lid.FStar_Ident.ident.FStar_Ident.idText) +end)) +end +in (Prims.raise (FStar_Syntax_Syntax.Error (((msg), ((FStar_Ident.range_of_lid lid))))))))) end | Some (r) -> begin r diff --git a/src/ocaml-output/FStar_Parser_ToSyntax.ml b/src/ocaml-output/FStar_Parser_ToSyntax.ml index 609c4a7ace7..0b1ff698932 100755 --- a/src/ocaml-output/FStar_Parser_ToSyntax.ml +++ b/src/ocaml-output/FStar_Parser_ToSyntax.ml @@ -13,7 +13,7 @@ None end)) -let trans_qual : FStar_Range.range -> FStar_Parser_AST.qualifier -> FStar_Syntax_Syntax.qualifier = (fun r _65_2 -> (match (_65_2) with +let trans_qual : FStar_Range.range -> FStar_Ident.lident Prims.option -> FStar_Parser_AST.qualifier -> FStar_Syntax_Syntax.qualifier = (fun r maybe_effect_id _65_2 -> (match (_65_2) with | FStar_Parser_AST.Private -> begin FStar_Syntax_Syntax.Private end @@ -47,11 +47,17 @@ end | FStar_Parser_AST.Opaque -> begin ( -let _65_46 = (FStar_TypeChecker_Errors.warn r "The \'opaque\' qualifier is deprecated since its use was strangely schizophrenic. There were two overloaded uses: (1) Given \'opaque val f : t\', the behavior was to exclude the definition of \'f\' to the SMT solver. This corresponds roughly to the new \'irreducible\' qualifier. (2) Given \'opaque type t = t\'\', the behavior was to provide the definition of \'t\' to the SMT solver, but not to inline it, unless absolutely required for unification. This corresponds roughly to the behavior of \'unfoldable\' (which is currently the default).") +let _65_47 = (FStar_TypeChecker_Errors.warn r "The \'opaque\' qualifier is deprecated since its use was strangely schizophrenic. There were two overloaded uses: (1) Given \'opaque val f : t\', the behavior was to exclude the definition of \'f\' to the SMT solver. This corresponds roughly to the new \'irreducible\' qualifier. (2) Given \'opaque type t = t\'\', the behavior was to provide the definition of \'t\' to the SMT solver, but not to inline it, unless absolutely required for unification. This corresponds roughly to the behavior of \'unfoldable\' (which is currently the default).") in FStar_Syntax_Syntax.Visible_default) end | FStar_Parser_AST.Reflectable -> begin -FStar_Syntax_Syntax.Reflectable +(match (maybe_effect_id) with +| None -> begin +(Prims.raise (FStar_Syntax_Syntax.Error ((("Qualifier reflect only supported on effects"), (r))))) +end +| Some (effect_id) -> begin +FStar_Syntax_Syntax.Reflectable (effect_id) +end) end | FStar_Parser_AST.Reifiable -> begin FStar_Syntax_Syntax.Reifiable @@ -83,7 +89,7 @@ let as_imp : FStar_Parser_AST.imp -> FStar_Syntax_Syntax.arg_qualifier Prims.o | FStar_Parser_AST.Hash -> begin Some (FStar_Syntax_Syntax.imp_tag) end -| _65_63 -> begin +| _65_67 -> begin None end)) @@ -95,16 +101,16 @@ let arg_withimp_t = (fun imp t -> (match (imp) with | FStar_Parser_AST.Hash -> begin ((t), (Some (FStar_Syntax_Syntax.imp_tag))) end -| _65_70 -> begin +| _65_74 -> begin ((t), (None)) end)) let contains_binder : FStar_Parser_AST.binder Prims.list -> Prims.bool = (fun binders -> (FStar_All.pipe_right binders (FStar_Util.for_some (fun b -> (match (b.FStar_Parser_AST.b) with -| FStar_Parser_AST.Annotated (_65_74) -> begin +| FStar_Parser_AST.Annotated (_65_78) -> begin true end -| _65_77 -> begin +| _65_81 -> begin false end))))) @@ -113,33 +119,33 @@ let rec unparen : FStar_Parser_AST.term -> FStar_Parser_AST.term = (fun t -> ( | FStar_Parser_AST.Paren (t) -> begin (unparen t) end -| _65_82 -> begin +| _65_86 -> begin t end)) -let tm_type_z : FStar_Range.range -> FStar_Parser_AST.term = (fun r -> (let _160_23 = (let _160_22 = (FStar_Ident.lid_of_path (("Type0")::[]) r) -in FStar_Parser_AST.Name (_160_22)) -in (FStar_Parser_AST.mk_term _160_23 r FStar_Parser_AST.Kind))) +let tm_type_z : FStar_Range.range -> FStar_Parser_AST.term = (fun r -> (let _160_25 = (let _160_24 = (FStar_Ident.lid_of_path (("Type0")::[]) r) +in FStar_Parser_AST.Name (_160_24)) +in (FStar_Parser_AST.mk_term _160_25 r FStar_Parser_AST.Kind))) -let tm_type : FStar_Range.range -> FStar_Parser_AST.term = (fun r -> (let _160_27 = (let _160_26 = (FStar_Ident.lid_of_path (("Type")::[]) r) -in FStar_Parser_AST.Name (_160_26)) -in (FStar_Parser_AST.mk_term _160_27 r FStar_Parser_AST.Kind))) +let tm_type : FStar_Range.range -> FStar_Parser_AST.term = (fun r -> (let _160_29 = (let _160_28 = (FStar_Ident.lid_of_path (("Type")::[]) r) +in FStar_Parser_AST.Name (_160_28)) +in (FStar_Parser_AST.mk_term _160_29 r FStar_Parser_AST.Kind))) let rec is_comp_type : FStar_Parser_Env.env -> FStar_Parser_AST.term -> Prims.bool = (fun env t -> (match (t.FStar_Parser_AST.tm) with | (FStar_Parser_AST.Name (l)) | (FStar_Parser_AST.Construct (l, _)) -> begin -(let _160_32 = (FStar_Parser_Env.try_lookup_effect_name env l) -in (FStar_All.pipe_right _160_32 FStar_Option.isSome)) +(let _160_34 = (FStar_Parser_Env.try_lookup_effect_name env l) +in (FStar_All.pipe_right _160_34 FStar_Option.isSome)) end -| FStar_Parser_AST.App (head, _65_95, _65_97) -> begin +| FStar_Parser_AST.App (head, _65_99, _65_101) -> begin (is_comp_type env head) end | (FStar_Parser_AST.Paren (t)) | (FStar_Parser_AST.Ascribed (t, _)) | (FStar_Parser_AST.LetOpen (_, t)) -> begin (is_comp_type env t) end -| _65_111 -> begin +| _65_115 -> begin false end)) @@ -201,7 +207,7 @@ end | ':' -> begin "Colon" end -| _65_133 -> begin +| _65_137 -> begin "UNKNOWN" end)) in ( @@ -209,10 +215,10 @@ in ( let rec aux = (fun i -> if (i = (FStar_String.length s)) then begin [] end else begin -(let _160_43 = (let _160_41 = (FStar_Util.char_at s i) -in (name_of_char _160_41)) -in (let _160_42 = (aux (i + (Prims.parse_int "1"))) -in (_160_43)::_160_42)) +(let _160_45 = (let _160_43 = (FStar_Util.char_at s i) +in (name_of_char _160_43)) +in (let _160_44 = (aux (i + (Prims.parse_int "1"))) +in (_160_45)::_160_44)) end) in (match (s) with | ".[]<-" -> begin @@ -227,28 +233,28 @@ end | ".()" -> begin "op_Array_Access" end -| _65_142 -> begin -(let _160_45 = (let _160_44 = (aux (Prims.parse_int "0")) -in (FStar_String.concat "_" _160_44)) -in (Prims.strcat "op_" _160_45)) +| _65_146 -> begin +(let _160_47 = (let _160_46 = (aux (Prims.parse_int "0")) +in (FStar_String.concat "_" _160_46)) +in (Prims.strcat "op_" _160_47)) end)))) -let compile_op_lid : Prims.int -> Prims.string -> FStar_Range.range -> FStar_Ident.lident = (fun n s r -> (let _160_55 = (let _160_54 = (let _160_53 = (let _160_52 = (compile_op n s) -in ((_160_52), (r))) -in (FStar_Ident.mk_ident _160_53)) -in (_160_54)::[]) -in (FStar_All.pipe_right _160_55 FStar_Ident.lid_of_ids))) +let compile_op_lid : Prims.int -> Prims.string -> FStar_Range.range -> FStar_Ident.lident = (fun n s r -> (let _160_57 = (let _160_56 = (let _160_55 = (let _160_54 = (compile_op n s) +in ((_160_54), (r))) +in (FStar_Ident.mk_ident _160_55)) +in (_160_56)::[]) +in (FStar_All.pipe_right _160_57 FStar_Ident.lid_of_ids))) let op_as_term : FStar_Parser_Env.env -> Prims.int -> FStar_Range.range -> Prims.string -> FStar_Syntax_Syntax.term Prims.option = (fun env arity rng s -> ( -let r = (fun l dd -> (let _160_69 = (let _160_68 = (FStar_Syntax_Syntax.lid_as_fv (FStar_Ident.set_lid_range l rng) dd None) -in (FStar_All.pipe_right _160_68 FStar_Syntax_Syntax.fv_to_tm)) -in Some (_160_69))) +let r = (fun l dd -> (let _160_71 = (let _160_70 = (FStar_Syntax_Syntax.lid_as_fv (FStar_Ident.set_lid_range l rng) dd None) +in (FStar_All.pipe_right _160_70 FStar_Syntax_Syntax.fv_to_tm)) +in Some (_160_71))) in ( -let fallback = (fun _65_154 -> (match (()) with +let fallback = (fun _65_158 -> (match (()) with | () -> begin (match (s) with | "=" -> begin @@ -329,57 +335,57 @@ end | "<==>" -> begin (r FStar_Syntax_Const.iff_lid (FStar_Syntax_Syntax.Delta_defined_at_level ((Prims.parse_int "2")))) end -| _65_182 -> begin +| _65_186 -> begin None end) end)) -in (match ((let _160_72 = (compile_op_lid arity s rng) -in (FStar_Parser_Env.try_lookup_lid env _160_72))) with +in (match ((let _160_74 = (compile_op_lid arity s rng) +in (FStar_Parser_Env.try_lookup_lid env _160_74))) with | Some (t) -> begin Some ((Prims.fst t)) end -| _65_186 -> begin +| _65_190 -> begin (fallback ()) end)))) -let sort_ftv : FStar_Ident.ident Prims.list -> FStar_Ident.ident Prims.list = (fun ftv -> (let _160_79 = (FStar_Util.remove_dups (fun x y -> (x.FStar_Ident.idText = y.FStar_Ident.idText)) ftv) -in (FStar_All.pipe_left (FStar_Util.sort_with (fun x y -> (FStar_String.compare x.FStar_Ident.idText y.FStar_Ident.idText))) _160_79))) +let sort_ftv : FStar_Ident.ident Prims.list -> FStar_Ident.ident Prims.list = (fun ftv -> (let _160_81 = (FStar_Util.remove_dups (fun x y -> (x.FStar_Ident.idText = y.FStar_Ident.idText)) ftv) +in (FStar_All.pipe_left (FStar_Util.sort_with (fun x y -> (FStar_String.compare x.FStar_Ident.idText y.FStar_Ident.idText))) _160_81))) let rec free_type_vars_b : FStar_Parser_Env.env -> FStar_Parser_AST.binder -> (FStar_Parser_Env.env * FStar_Ident.ident Prims.list) = (fun env binder -> (match (binder.FStar_Parser_AST.b) with -| FStar_Parser_AST.Variable (_65_195) -> begin +| FStar_Parser_AST.Variable (_65_199) -> begin ((env), ([])) end | FStar_Parser_AST.TVariable (x) -> begin ( -let _65_202 = (FStar_Parser_Env.push_bv env x) -in (match (_65_202) with -| (env, _65_201) -> begin +let _65_206 = (FStar_Parser_Env.push_bv env x) +in (match (_65_206) with +| (env, _65_205) -> begin ((env), ((x)::[])) end)) end -| FStar_Parser_AST.Annotated (_65_204, term) -> begin -(let _160_86 = (free_type_vars env term) -in ((env), (_160_86))) +| FStar_Parser_AST.Annotated (_65_208, term) -> begin +(let _160_88 = (free_type_vars env term) +in ((env), (_160_88))) end -| FStar_Parser_AST.TAnnotated (id, _65_210) -> begin +| FStar_Parser_AST.TAnnotated (id, _65_214) -> begin ( -let _65_216 = (FStar_Parser_Env.push_bv env id) -in (match (_65_216) with -| (env, _65_215) -> begin +let _65_220 = (FStar_Parser_Env.push_bv env id) +in (match (_65_220) with +| (env, _65_219) -> begin ((env), ([])) end)) end | FStar_Parser_AST.NoName (t) -> begin -(let _160_87 = (free_type_vars env t) -in ((env), (_160_87))) +(let _160_89 = (free_type_vars env t) +in ((env), (_160_89))) end)) -and free_type_vars : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Ident.ident Prims.list = (fun env t -> (match ((let _160_90 = (unparen t) -in _160_90.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.Labeled (_65_222) -> begin +and free_type_vars : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Ident.ident Prims.list = (fun env t -> (match ((let _160_92 = (unparen t) +in _160_92.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.Labeled (_65_226) -> begin (FStar_All.failwith "Impossible --- labeled source term") end | FStar_Parser_AST.Tvar (a) -> begin @@ -387,60 +393,60 @@ end | None -> begin (a)::[] end -| _65_228 -> begin +| _65_232 -> begin [] end) end -| (FStar_Parser_AST.Wild) | (FStar_Parser_AST.Const (_)) | (FStar_Parser_AST.Var (_)) | (FStar_Parser_AST.Name (_)) -> begin +| (FStar_Parser_AST.Wild) | (FStar_Parser_AST.Const (_)) | (FStar_Parser_AST.Var (_)) | (FStar_Parser_AST.Projector (_)) | (FStar_Parser_AST.Discrim (_)) | (FStar_Parser_AST.Name (_)) -> begin [] end | (FStar_Parser_AST.Assign (_, t)) | (FStar_Parser_AST.Requires (t, _)) | (FStar_Parser_AST.Ensures (t, _)) | (FStar_Parser_AST.NamedTyp (_, t)) | (FStar_Parser_AST.Paren (t)) | (FStar_Parser_AST.Ascribed (t, _)) -> begin (free_type_vars env t) end -| FStar_Parser_AST.Construct (_65_262, ts) -> begin -(FStar_List.collect (fun _65_269 -> (match (_65_269) with -| (t, _65_268) -> begin +| FStar_Parser_AST.Construct (_65_272, ts) -> begin +(FStar_List.collect (fun _65_279 -> (match (_65_279) with +| (t, _65_278) -> begin (free_type_vars env t) end)) ts) end -| FStar_Parser_AST.Op (_65_271, ts) -> begin +| FStar_Parser_AST.Op (_65_281, ts) -> begin (FStar_List.collect (free_type_vars env) ts) end -| FStar_Parser_AST.App (t1, t2, _65_278) -> begin -(let _160_93 = (free_type_vars env t1) -in (let _160_92 = (free_type_vars env t2) -in (FStar_List.append _160_93 _160_92))) +| FStar_Parser_AST.App (t1, t2, _65_288) -> begin +(let _160_95 = (free_type_vars env t1) +in (let _160_94 = (free_type_vars env t2) +in (FStar_List.append _160_95 _160_94))) end | FStar_Parser_AST.Refine (b, t) -> begin ( -let _65_287 = (free_type_vars_b env b) -in (match (_65_287) with +let _65_297 = (free_type_vars_b env b) +in (match (_65_297) with | (env, f) -> begin -(let _160_94 = (free_type_vars env t) -in (FStar_List.append f _160_94)) +(let _160_96 = (free_type_vars env t) +in (FStar_List.append f _160_96)) end)) end | (FStar_Parser_AST.Product (binders, body)) | (FStar_Parser_AST.Sum (binders, body)) -> begin ( -let _65_303 = (FStar_List.fold_left (fun _65_296 binder -> (match (_65_296) with +let _65_313 = (FStar_List.fold_left (fun _65_306 binder -> (match (_65_306) with | (env, free) -> begin ( -let _65_300 = (free_type_vars_b env binder) -in (match (_65_300) with +let _65_310 = (free_type_vars_b env binder) +in (match (_65_310) with | (env, f) -> begin ((env), ((FStar_List.append f free))) end)) end)) ((env), ([])) binders) -in (match (_65_303) with +in (match (_65_313) with | (env, free) -> begin -(let _160_97 = (free_type_vars env body) -in (FStar_List.append free _160_97)) +(let _160_99 = (free_type_vars env body) +in (FStar_List.append free _160_99)) end)) end -| FStar_Parser_AST.Project (t, _65_306) -> begin +| FStar_Parser_AST.Project (t, _65_316) -> begin (free_type_vars env t) end | (FStar_Parser_AST.Abs (_)) | (FStar_Parser_AST.Let (_)) | (FStar_Parser_AST.LetOpen (_)) | (FStar_Parser_AST.If (_)) | (FStar_Parser_AST.QForall (_)) | (FStar_Parser_AST.QExists (_)) | (FStar_Parser_AST.Record (_)) | (FStar_Parser_AST.Match (_)) | (FStar_Parser_AST.TryWith (_)) | (FStar_Parser_AST.Seq (_)) -> begin @@ -450,15 +456,15 @@ end)) let head_and_args : FStar_Parser_AST.term -> (FStar_Parser_AST.term * (FStar_Parser_AST.term * FStar_Parser_AST.imp) Prims.list) = (fun t -> ( -let rec aux = (fun args t -> (match ((let _160_104 = (unparen t) -in _160_104.FStar_Parser_AST.tm)) with +let rec aux = (fun args t -> (match ((let _160_106 = (unparen t) +in _160_106.FStar_Parser_AST.tm)) with | FStar_Parser_AST.App (t, arg, imp) -> begin (aux ((((arg), (imp)))::args) t) end | FStar_Parser_AST.Construct (l, args') -> begin (({FStar_Parser_AST.tm = FStar_Parser_AST.Name (l); FStar_Parser_AST.range = t.FStar_Parser_AST.range; FStar_Parser_AST.level = t.FStar_Parser_AST.level}), ((FStar_List.append args' args))) end -| _65_353 -> begin +| _65_363 -> begin ((t), (args)) end)) in (aux [] t))) @@ -466,17 +472,17 @@ in (aux [] t))) let close : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Parser_AST.term = (fun env t -> ( -let ftv = (let _160_109 = (free_type_vars env t) -in (FStar_All.pipe_left sort_ftv _160_109)) +let ftv = (let _160_111 = (free_type_vars env t) +in (FStar_All.pipe_left sort_ftv _160_111)) in if ((FStar_List.length ftv) = (Prims.parse_int "0")) then begin t end else begin ( -let binders = (FStar_All.pipe_right ftv (FStar_List.map (fun x -> (let _160_113 = (let _160_112 = (let _160_111 = (tm_type x.FStar_Ident.idRange) -in ((x), (_160_111))) -in FStar_Parser_AST.TAnnotated (_160_112)) -in (FStar_Parser_AST.mk_binder _160_113 x.FStar_Ident.idRange FStar_Parser_AST.Type (Some (FStar_Parser_AST.Implicit))))))) +let binders = (FStar_All.pipe_right ftv (FStar_List.map (fun x -> (let _160_115 = (let _160_114 = (let _160_113 = (tm_type x.FStar_Ident.idRange) +in ((x), (_160_113))) +in FStar_Parser_AST.TAnnotated (_160_114)) +in (FStar_Parser_AST.mk_binder _160_115 x.FStar_Ident.idRange FStar_Parser_AST.Type (Some (FStar_Parser_AST.Implicit))))))) in ( let result = (FStar_Parser_AST.mk_term (FStar_Parser_AST.Product (((binders), (t)))) t.FStar_Parser_AST.range t.FStar_Parser_AST.level) @@ -486,25 +492,25 @@ end)) let close_fun : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Parser_AST.term = (fun env t -> ( -let ftv = (let _160_118 = (free_type_vars env t) -in (FStar_All.pipe_left sort_ftv _160_118)) +let ftv = (let _160_120 = (free_type_vars env t) +in (FStar_All.pipe_left sort_ftv _160_120)) in if ((FStar_List.length ftv) = (Prims.parse_int "0")) then begin t end else begin ( -let binders = (FStar_All.pipe_right ftv (FStar_List.map (fun x -> (let _160_122 = (let _160_121 = (let _160_120 = (tm_type x.FStar_Ident.idRange) -in ((x), (_160_120))) -in FStar_Parser_AST.TAnnotated (_160_121)) -in (FStar_Parser_AST.mk_binder _160_122 x.FStar_Ident.idRange FStar_Parser_AST.Type (Some (FStar_Parser_AST.Implicit))))))) +let binders = (FStar_All.pipe_right ftv (FStar_List.map (fun x -> (let _160_124 = (let _160_123 = (let _160_122 = (tm_type x.FStar_Ident.idRange) +in ((x), (_160_122))) +in FStar_Parser_AST.TAnnotated (_160_123)) +in (FStar_Parser_AST.mk_binder _160_124 x.FStar_Ident.idRange FStar_Parser_AST.Type (Some (FStar_Parser_AST.Implicit))))))) in ( -let t = (match ((let _160_123 = (unparen t) -in _160_123.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.Product (_65_366) -> begin +let t = (match ((let _160_125 = (unparen t) +in _160_125.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.Product (_65_376) -> begin t end -| _65_369 -> begin +| _65_379 -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.App ((((FStar_Parser_AST.mk_term (FStar_Parser_AST.Name (FStar_Syntax_Const.effect_Tot_lid)) t.FStar_Parser_AST.range t.FStar_Parser_AST.level)), (t), (FStar_Parser_AST.Nothing)))) t.FStar_Parser_AST.range t.FStar_Parser_AST.level) end) in ( @@ -518,7 +524,7 @@ let rec uncurry : FStar_Parser_AST.binder Prims.list -> FStar_Parser_AST.term | FStar_Parser_AST.Product (binders, t) -> begin (uncurry (FStar_List.append bs binders) t) end -| _65_379 -> begin +| _65_389 -> begin ((bs), (t)) end)) @@ -527,22 +533,22 @@ let rec is_var_pattern : FStar_Parser_AST.pattern -> Prims.bool = (fun p -> (m | (FStar_Parser_AST.PatWild) | (FStar_Parser_AST.PatTvar (_, _)) | (FStar_Parser_AST.PatVar (_, _)) -> begin true end -| FStar_Parser_AST.PatAscribed (p, _65_396) -> begin +| FStar_Parser_AST.PatAscribed (p, _65_406) -> begin (is_var_pattern p) end -| _65_400 -> begin +| _65_410 -> begin false end)) let rec is_app_pattern : FStar_Parser_AST.pattern -> Prims.bool = (fun p -> (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed (p, _65_404) -> begin +| FStar_Parser_AST.PatAscribed (p, _65_414) -> begin (is_app_pattern p) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (_65_410); FStar_Parser_AST.prange = _65_408}, _65_414) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (_65_420); FStar_Parser_AST.prange = _65_418}, _65_424) -> begin true end -| _65_418 -> begin +| _65_428 -> begin false end)) @@ -551,7 +557,7 @@ let replace_unit_pattern : FStar_Parser_AST.pattern -> FStar_Parser_AST.patter | FStar_Parser_AST.PatConst (FStar_Const.Const_unit) -> begin (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatAscribed ((((FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild p.FStar_Parser_AST.prange)), (unit_ty)))) p.FStar_Parser_AST.prange) end -| _65_423 -> begin +| _65_433 -> begin p end)) @@ -560,21 +566,21 @@ let rec destruct_app_pattern : FStar_Parser_Env.env -> Prims.bool -> FStar_P | FStar_Parser_AST.PatAscribed (p, t) -> begin ( -let _65_435 = (destruct_app_pattern env is_top_level p) -in (match (_65_435) with -| (name, args, _65_434) -> begin +let _65_445 = (destruct_app_pattern env is_top_level p) +in (match (_65_445) with +| (name, args, _65_444) -> begin ((name), (args), (Some (t))) end)) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_440); FStar_Parser_AST.prange = _65_437}, args) when is_top_level -> begin -(let _160_141 = (let _160_140 = (FStar_Parser_Env.qualify env id) -in FStar_Util.Inr (_160_140)) -in ((_160_141), (args), (None))) +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_450); FStar_Parser_AST.prange = _65_447}, args) when is_top_level -> begin +(let _160_143 = (let _160_142 = (FStar_Parser_Env.qualify env id) +in FStar_Util.Inr (_160_142)) +in ((_160_143), (args), (None))) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_451); FStar_Parser_AST.prange = _65_448}, args) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_461); FStar_Parser_AST.prange = _65_458}, args) -> begin ((FStar_Util.Inl (id)), (args), (None)) end -| _65_459 -> begin +| _65_469 -> begin (FStar_All.failwith "Not an app pattern") end)) @@ -603,14 +609,14 @@ end)) let ___LocalBinder____0 = (fun projectee -> (match (projectee) with -| LocalBinder (_65_462) -> begin -_65_462 +| LocalBinder (_65_472) -> begin +_65_472 end)) let ___LetBinder____0 = (fun projectee -> (match (projectee) with -| LetBinder (_65_465) -> begin -_65_465 +| LetBinder (_65_475) -> begin +_65_475 end)) @@ -618,26 +624,26 @@ let binder_of_bnd : bnd -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.aqual | LocalBinder (a, aq) -> begin ((a), (aq)) end -| _65_472 -> begin +| _65_482 -> begin (FStar_All.failwith "Impossible") end)) let as_binder : FStar_Parser_Env.env -> FStar_Parser_AST.arg_qualifier Prims.option -> (FStar_Ident.ident Prims.option * FStar_Syntax_Syntax.term) -> (FStar_Syntax_Syntax.binder * FStar_Parser_Env.env) = (fun env imp _65_7 -> (match (_65_7) with | (None, k) -> begin -(let _160_178 = (FStar_Syntax_Syntax.null_binder k) -in ((_160_178), (env))) +(let _160_180 = (FStar_Syntax_Syntax.null_binder k) +in ((_160_180), (env))) end | (Some (a), k) -> begin ( -let _65_485 = (FStar_Parser_Env.push_bv env a) -in (match (_65_485) with +let _65_495 = (FStar_Parser_Env.push_bv env a) +in (match (_65_495) with | (env, a) -> begin ((((( -let _65_486 = a -in {FStar_Syntax_Syntax.ppname = _65_486.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_486.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k})), ((trans_aqual imp)))), (env)) +let _65_496 = a +in {FStar_Syntax_Syntax.ppname = _65_496.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_496.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k})), ((trans_aqual imp)))), (env)) end)) end)) @@ -650,7 +656,7 @@ type lenv_t = FStar_Syntax_Syntax.bv Prims.list -let mk_lb : (FStar_Syntax_Syntax.lbname * FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.term) -> FStar_Syntax_Syntax.letbinding = (fun _65_491 -> (match (_65_491) with +let mk_lb : (FStar_Syntax_Syntax.lbname * FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.term) -> FStar_Syntax_Syntax.letbinding = (fun _65_501 -> (match (_65_501) with | (n, t, e) -> begin {FStar_Syntax_Syntax.lbname = n; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_ALL_lid; FStar_Syntax_Syntax.lbdef = e} end)) @@ -661,40 +667,40 @@ let no_annot_abs : (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier P let mk_ref_read = (fun tm -> ( -let tm' = (let _160_191 = (let _160_190 = (let _160_186 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.sread_lid FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_186)) -in (let _160_189 = (let _160_188 = (let _160_187 = (FStar_Syntax_Syntax.as_implicit false) -in ((tm), (_160_187))) -in (_160_188)::[]) -in ((_160_190), (_160_189)))) -in FStar_Syntax_Syntax.Tm_app (_160_191)) +let tm' = (let _160_193 = (let _160_192 = (let _160_188 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.sread_lid FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_188)) +in (let _160_191 = (let _160_190 = (let _160_189 = (FStar_Syntax_Syntax.as_implicit false) +in ((tm), (_160_189))) +in (_160_190)::[]) +in ((_160_192), (_160_191)))) +in FStar_Syntax_Syntax.Tm_app (_160_193)) in (FStar_Syntax_Syntax.mk tm' None tm.FStar_Syntax_Syntax.pos))) let mk_ref_alloc = (fun tm -> ( -let tm' = (let _160_198 = (let _160_197 = (let _160_193 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.salloc_lid FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_193)) -in (let _160_196 = (let _160_195 = (let _160_194 = (FStar_Syntax_Syntax.as_implicit false) -in ((tm), (_160_194))) -in (_160_195)::[]) -in ((_160_197), (_160_196)))) -in FStar_Syntax_Syntax.Tm_app (_160_198)) +let tm' = (let _160_200 = (let _160_199 = (let _160_195 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.salloc_lid FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_195)) +in (let _160_198 = (let _160_197 = (let _160_196 = (FStar_Syntax_Syntax.as_implicit false) +in ((tm), (_160_196))) +in (_160_197)::[]) +in ((_160_199), (_160_198)))) +in FStar_Syntax_Syntax.Tm_app (_160_200)) in (FStar_Syntax_Syntax.mk tm' None tm.FStar_Syntax_Syntax.pos))) let mk_ref_assign = (fun t1 t2 pos -> ( -let tm = (let _160_210 = (let _160_209 = (let _160_202 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.swrite_lid FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_202)) -in (let _160_208 = (let _160_207 = (let _160_203 = (FStar_Syntax_Syntax.as_implicit false) -in ((t1), (_160_203))) -in (let _160_206 = (let _160_205 = (let _160_204 = (FStar_Syntax_Syntax.as_implicit false) -in ((t2), (_160_204))) -in (_160_205)::[]) -in (_160_207)::_160_206)) -in ((_160_209), (_160_208)))) -in FStar_Syntax_Syntax.Tm_app (_160_210)) +let tm = (let _160_212 = (let _160_211 = (let _160_204 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.swrite_lid FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_204)) +in (let _160_210 = (let _160_209 = (let _160_205 = (FStar_Syntax_Syntax.as_implicit false) +in ((t1), (_160_205))) +in (let _160_208 = (let _160_207 = (let _160_206 = (FStar_Syntax_Syntax.as_implicit false) +in ((t2), (_160_206))) +in (_160_207)::[]) +in (_160_209)::_160_208)) +in ((_160_211), (_160_210)))) +in FStar_Syntax_Syntax.Tm_app (_160_212)) in (FStar_Syntax_Syntax.mk tm None pos))) @@ -702,7 +708,7 @@ let is_special_effect_combinator : Prims.string -> Prims.bool = (fun _65_8 -> | ("repr") | ("post") | ("pre") | ("wp") -> begin true end -| _65_508 -> begin +| _65_518 -> begin false end)) @@ -718,11 +724,11 @@ end | FStar_Syntax_Syntax.Pat_var (x) -> begin (FStar_Util.set_add x FStar_Syntax_Syntax.no_names) end -| FStar_Syntax_Syntax.Pat_cons (_65_528, pats) -> begin -(FStar_All.pipe_right pats (FStar_List.fold_left (fun out _65_536 -> (match (_65_536) with -| (p, _65_535) -> begin -(let _160_259 = (pat_vars p) -in (FStar_Util.set_union out _160_259)) +| FStar_Syntax_Syntax.Pat_cons (_65_538, pats) -> begin +(FStar_All.pipe_right pats (FStar_List.fold_left (fun out _65_546 -> (match (_65_546) with +| (p, _65_545) -> begin +(let _160_269 = (pat_vars p) +in (FStar_Util.set_union out _160_269)) end)) FStar_Syntax_Syntax.no_names)) end | FStar_Syntax_Syntax.Pat_disj ([]) -> begin @@ -744,11 +750,11 @@ end)) in (pat_vars p))) in ( -let _65_559 = (match (((is_mut), (p.FStar_Parser_AST.pat))) with +let _65_569 = (match (((is_mut), (p.FStar_Parser_AST.pat))) with | ((false, _)) | ((true, FStar_Parser_AST.PatVar (_))) -> begin () end -| (true, _65_557) -> begin +| (true, _65_567) -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("let-mutable is for variables only"), (p.FStar_Parser_AST.prange))))) end) in ( @@ -764,11 +770,11 @@ let resolvex = (fun l e x -> (match ((FStar_All.pipe_right l (FStar_Util.find_op | Some (y) -> begin ((l), (e), (y)) end -| _65_570 -> begin +| _65_580 -> begin ( -let _65_573 = (push_bv_maybe_mut e x) -in (match (_65_573) with +let _65_583 = (push_bv_maybe_mut e x) +in (match (_65_583) with | (e, x) -> begin (((x)::l), (e), (x)) end)) @@ -779,11 +785,11 @@ let resolvea = (fun l e a -> (match ((FStar_All.pipe_right l (FStar_Util.find_op | Some (b) -> begin ((l), (e), (b)) end -| _65_582 -> begin +| _65_592 -> begin ( -let _65_585 = (push_bv_maybe_mut e a) -in (match (_65_585) with +let _65_595 = (push_bv_maybe_mut e a) +in (match (_65_595) with | (e, a) -> begin (((a)::l), (e), (a)) end)) @@ -798,12 +804,12 @@ in ( let pos_r = (fun r q -> (FStar_Syntax_Syntax.withinfo q FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n r)) in (match (p.FStar_Parser_AST.pat) with | FStar_Parser_AST.PatOp (op) -> begin -(let _160_295 = (let _160_294 = (let _160_293 = (let _160_292 = (let _160_291 = (compile_op (Prims.parse_int "0") op) -in (FStar_Ident.id_of_text _160_291)) -in ((_160_292), (None))) -in FStar_Parser_AST.PatVar (_160_293)) -in {FStar_Parser_AST.pat = _160_294; FStar_Parser_AST.prange = p.FStar_Parser_AST.prange}) -in (aux loc env _160_295)) +(let _160_305 = (let _160_304 = (let _160_303 = (let _160_302 = (let _160_301 = (compile_op (Prims.parse_int "0") op) +in (FStar_Ident.id_of_text _160_301)) +in ((_160_302), (None))) +in FStar_Parser_AST.PatVar (_160_303)) +in {FStar_Parser_AST.pat = _160_304; FStar_Parser_AST.prange = p.FStar_Parser_AST.prange}) +in (aux loc env _160_305)) end | FStar_Parser_AST.PatOr ([]) -> begin (FStar_All.failwith "impossible") @@ -811,22 +817,22 @@ end | FStar_Parser_AST.PatOr ((p)::ps) -> begin ( -let _65_609 = (aux loc env p) -in (match (_65_609) with -| (loc, env, var, p, _65_608) -> begin +let _65_619 = (aux loc env p) +in (match (_65_619) with +| (loc, env, var, p, _65_618) -> begin ( -let _65_626 = (FStar_List.fold_left (fun _65_613 p -> (match (_65_613) with +let _65_636 = (FStar_List.fold_left (fun _65_623 p -> (match (_65_623) with | (loc, env, ps) -> begin ( -let _65_622 = (aux loc env p) -in (match (_65_622) with -| (loc, env, _65_618, p, _65_621) -> begin +let _65_632 = (aux loc env p) +in (match (_65_632) with +| (loc, env, _65_628, p, _65_631) -> begin ((loc), (env), ((p)::ps)) end)) end)) ((loc), (env), ([])) ps) -in (match (_65_626) with +in (match (_65_636) with | (loc, env, ps) -> begin ( @@ -838,24 +844,24 @@ end | FStar_Parser_AST.PatAscribed (p, t) -> begin ( -let _65_637 = (aux loc env p) -in (match (_65_637) with +let _65_647 = (aux loc env p) +in (match (_65_647) with | (loc, env', binder, p, imp) -> begin ( let binder = (match (binder) with -| LetBinder (_65_639) -> begin +| LetBinder (_65_649) -> begin (FStar_All.failwith "impossible") end | LocalBinder (x, aq) -> begin ( -let t = (let _160_298 = (close_fun env t) -in (desugar_term env _160_298)) +let t = (let _160_308 = (close_fun env t) +in (desugar_term env _160_308)) in LocalBinder (((( -let _65_646 = x -in {FStar_Syntax_Syntax.ppname = _65_646.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_646.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = t})), (aq)))) +let _65_656 = x +in {FStar_Syntax_Syntax.ppname = _65_656.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_656.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = t})), (aq)))) end) in ((loc), (env'), (binder), (p), (imp))) end)) @@ -864,15 +870,15 @@ end ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) -in (let _160_299 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_wild (x))) -in ((loc), (env), (LocalBinder (((x), (None)))), (_160_299), (false)))) +in (let _160_309 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_wild (x))) +in ((loc), (env), (LocalBinder (((x), (None)))), (_160_309), (false)))) end | FStar_Parser_AST.PatConst (c) -> begin ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) -in (let _160_300 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_constant (c))) -in ((loc), (env), (LocalBinder (((x), (None)))), (_160_300), (false)))) +in (let _160_310 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_constant (c))) +in ((loc), (env), (LocalBinder (((x), (None)))), (_160_310), (false)))) end | (FStar_Parser_AST.PatTvar (x, aq)) | (FStar_Parser_AST.PatVar (x, aq)) -> begin ( @@ -883,11 +889,11 @@ in ( let aq = (trans_aqual aq) in ( -let _65_665 = (resolvex loc env x) -in (match (_65_665) with +let _65_675 = (resolvex loc env x) +in (match (_65_675) with | (loc, env, xbv) -> begin -(let _160_301 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_var (xbv))) -in ((loc), (env), (LocalBinder (((xbv), (aq)))), (_160_301), (imp))) +(let _160_311 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_var (xbv))) +in ((loc), (env), (LocalBinder (((xbv), (aq)))), (_160_311), (imp))) end)))) end | FStar_Parser_AST.PatName (l) -> begin @@ -897,23 +903,23 @@ let l = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_datacon env) in ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) -in (let _160_302 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), ([]))))) -in ((loc), (env), (LocalBinder (((x), (None)))), (_160_302), (false))))) +in (let _160_312 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), ([]))))) +in ((loc), (env), (LocalBinder (((x), (None)))), (_160_312), (false))))) end -| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatName (l); FStar_Parser_AST.prange = _65_671}, args) -> begin +| FStar_Parser_AST.PatApp ({FStar_Parser_AST.pat = FStar_Parser_AST.PatName (l); FStar_Parser_AST.prange = _65_681}, args) -> begin ( -let _65_693 = (FStar_List.fold_right (fun arg _65_682 -> (match (_65_682) with +let _65_703 = (FStar_List.fold_right (fun arg _65_692 -> (match (_65_692) with | (loc, env, args) -> begin ( -let _65_689 = (aux loc env arg) -in (match (_65_689) with -| (loc, env, _65_686, arg, imp) -> begin +let _65_699 = (aux loc env arg) +in (match (_65_699) with +| (loc, env, _65_696, arg, imp) -> begin ((loc), (env), ((((arg), (imp)))::args)) end)) end)) args ((loc), (env), ([]))) -in (match (_65_693) with +in (match (_65_703) with | (loc, env, args) -> begin ( @@ -921,43 +927,43 @@ let l = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_datacon env) in ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) -in (let _160_305 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), (args))))) -in ((loc), (env), (LocalBinder (((x), (None)))), (_160_305), (false))))) +in (let _160_315 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), (args))))) +in ((loc), (env), (LocalBinder (((x), (None)))), (_160_315), (false))))) end)) end -| FStar_Parser_AST.PatApp (_65_697) -> begin +| FStar_Parser_AST.PatApp (_65_707) -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected pattern"), (p.FStar_Parser_AST.prange))))) end | FStar_Parser_AST.PatList (pats) -> begin ( -let _65_717 = (FStar_List.fold_right (fun pat _65_705 -> (match (_65_705) with +let _65_727 = (FStar_List.fold_right (fun pat _65_715 -> (match (_65_715) with | (loc, env, pats) -> begin ( -let _65_713 = (aux loc env pat) -in (match (_65_713) with -| (loc, env, _65_709, pat, _65_712) -> begin +let _65_723 = (aux loc env pat) +in (match (_65_723) with +| (loc, env, _65_719, pat, _65_722) -> begin ((loc), (env), ((pat)::pats)) end)) end)) pats ((loc), (env), ([]))) -in (match (_65_717) with +in (match (_65_727) with | (loc, env, pats) -> begin ( -let pat = (let _160_318 = (let _160_317 = (let _160_313 = (FStar_Range.end_range p.FStar_Parser_AST.prange) -in (pos_r _160_313)) -in (let _160_316 = (let _160_315 = (let _160_314 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.nil_lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) -in ((_160_314), ([]))) -in FStar_Syntax_Syntax.Pat_cons (_160_315)) -in (FStar_All.pipe_left _160_317 _160_316))) +let pat = (let _160_328 = (let _160_327 = (let _160_323 = (FStar_Range.end_range p.FStar_Parser_AST.prange) +in (pos_r _160_323)) +in (let _160_326 = (let _160_325 = (let _160_324 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.nil_lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) +in ((_160_324), ([]))) +in FStar_Syntax_Syntax.Pat_cons (_160_325)) +in (FStar_All.pipe_left _160_327 _160_326))) in (FStar_List.fold_right (fun hd tl -> ( let r = (FStar_Range.union_ranges hd.FStar_Syntax_Syntax.p tl.FStar_Syntax_Syntax.p) -in (let _160_312 = (let _160_311 = (let _160_310 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.cons_lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) -in ((_160_310), ((((hd), (false)))::(((tl), (false)))::[]))) -in FStar_Syntax_Syntax.Pat_cons (_160_311)) -in (FStar_All.pipe_left (pos_r r) _160_312)))) pats _160_318)) +in (let _160_322 = (let _160_321 = (let _160_320 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.cons_lid FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) +in ((_160_320), ((((hd), (false)))::(((tl), (false)))::[]))) +in FStar_Syntax_Syntax.Pat_cons (_160_321)) +in (FStar_All.pipe_left (pos_r r) _160_322)))) pats _160_328)) in ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) @@ -967,17 +973,17 @@ end | FStar_Parser_AST.PatTuple (args, dep) -> begin ( -let _65_743 = (FStar_List.fold_left (fun _65_730 p -> (match (_65_730) with +let _65_753 = (FStar_List.fold_left (fun _65_740 p -> (match (_65_740) with | (loc, env, pats) -> begin ( -let _65_739 = (aux loc env p) -in (match (_65_739) with -| (loc, env, _65_735, pat, _65_738) -> begin +let _65_749 = (aux loc env p) +in (match (_65_749) with +| (loc, env, _65_745, pat, _65_748) -> begin ((loc), (env), ((((pat), (false)))::pats)) end)) end)) ((loc), (env), ([])) args) -in (match (_65_743) with +in (match (_65_753) with | (loc, env, args) -> begin ( @@ -991,23 +997,23 @@ end else begin end in ( -let _65_749 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) l) -in (match (_65_749) with -| (constr, _65_748) -> begin +let _65_759 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) l) +in (match (_65_759) with +| (constr, _65_758) -> begin ( let l = (match (constr.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin fv end -| _65_753 -> begin +| _65_763 -> begin (FStar_All.failwith "impossible") end) in ( let x = (FStar_Syntax_Syntax.new_bv (Some (p.FStar_Parser_AST.prange)) FStar_Syntax_Syntax.tun) -in (let _160_321 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), (args))))) -in ((loc), (env), (LocalBinder (((x), (None)))), (_160_321), (false))))) +in (let _160_331 = (FStar_All.pipe_left pos (FStar_Syntax_Syntax.Pat_cons (((l), (args))))) +in ((loc), (env), (LocalBinder (((x), (None)))), (_160_331), (false))))) end)))) end)) end @@ -1017,33 +1023,33 @@ end | FStar_Parser_AST.PatRecord (fields) -> begin ( -let _65_763 = (FStar_List.hd fields) -in (match (_65_763) with -| (f, _65_762) -> begin +let _65_773 = (FStar_List.hd fields) +in (match (_65_773) with +| (f, _65_772) -> begin ( -let _65_767 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_record_by_field_name env) f) -in (match (_65_767) with -| (record, _65_766) -> begin +let _65_777 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_record_by_field_name env) f) +in (match (_65_777) with +| (record, _65_776) -> begin ( -let fields = (FStar_All.pipe_right fields (FStar_List.map (fun _65_770 -> (match (_65_770) with +let fields = (FStar_All.pipe_right fields (FStar_List.map (fun _65_780 -> (match (_65_780) with | (f, p) -> begin -(let _160_323 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.qualify_field_to_record env record) f) -in ((_160_323), (p))) +(let _160_333 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.qualify_field_to_record env record) f) +in ((_160_333), (p))) end)))) in ( -let args = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_775 -> (match (_65_775) with -| (f, _65_774) -> begin -(match ((FStar_All.pipe_right fields (FStar_List.tryFind (fun _65_779 -> (match (_65_779) with -| (g, _65_778) -> begin +let args = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_785 -> (match (_65_785) with +| (f, _65_784) -> begin +(match ((FStar_All.pipe_right fields (FStar_List.tryFind (fun _65_789 -> (match (_65_789) with +| (g, _65_788) -> begin (FStar_Ident.lid_equals f g) end))))) with | None -> begin (FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild p.FStar_Parser_AST.prange) end -| Some (_65_782, p) -> begin +| Some (_65_792, p) -> begin p end) end)))) @@ -1052,26 +1058,26 @@ in ( let app = (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatApp ((((FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatName (record.FStar_Parser_Env.constrname)) p.FStar_Parser_AST.prange)), (args)))) p.FStar_Parser_AST.prange) in ( -let _65_794 = (aux loc env app) -in (match (_65_794) with -| (env, e, b, p, _65_793) -> begin +let _65_804 = (aux loc env app) +in (match (_65_804) with +| (env, e, b, p, _65_803) -> begin ( let p = (match (p.FStar_Syntax_Syntax.v) with | FStar_Syntax_Syntax.Pat_cons (fv, args) -> begin -(let _160_332 = (let _160_331 = (let _160_330 = ( - -let _65_799 = fv -in (let _160_329 = (let _160_328 = (let _160_327 = (let _160_326 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map Prims.fst)) -in ((record.FStar_Parser_Env.typename), (_160_326))) -in FStar_Syntax_Syntax.Record_ctor (_160_327)) -in Some (_160_328)) -in {FStar_Syntax_Syntax.fv_name = _65_799.FStar_Syntax_Syntax.fv_name; FStar_Syntax_Syntax.fv_delta = _65_799.FStar_Syntax_Syntax.fv_delta; FStar_Syntax_Syntax.fv_qual = _160_329})) -in ((_160_330), (args))) -in FStar_Syntax_Syntax.Pat_cons (_160_331)) -in (FStar_All.pipe_left pos _160_332)) -end -| _65_802 -> begin +(let _160_342 = (let _160_341 = (let _160_340 = ( + +let _65_809 = fv +in (let _160_339 = (let _160_338 = (let _160_337 = (let _160_336 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map Prims.fst)) +in ((record.FStar_Parser_Env.typename), (_160_336))) +in FStar_Syntax_Syntax.Record_ctor (_160_337)) +in Some (_160_338)) +in {FStar_Syntax_Syntax.fv_name = _65_809.FStar_Syntax_Syntax.fv_name; FStar_Syntax_Syntax.fv_delta = _65_809.FStar_Syntax_Syntax.fv_delta; FStar_Syntax_Syntax.fv_qual = _160_339})) +in ((_160_340), (args))) +in FStar_Syntax_Syntax.Pat_cons (_160_341)) +in (FStar_All.pipe_left pos _160_342)) +end +| _65_812 -> begin p end) in ((env), (e), (b), (p), (false))) @@ -1081,46 +1087,46 @@ end)) end)))) in ( -let _65_811 = (aux [] env p) -in (match (_65_811) with -| (_65_805, env, b, p, _65_810) -> begin +let _65_821 = (aux [] env p) +in (match (_65_821) with +| (_65_815, env, b, p, _65_820) -> begin ( -let _65_812 = (let _160_333 = (check_linear_pattern_variables p) -in (FStar_All.pipe_left Prims.ignore _160_333)) +let _65_822 = (let _160_343 = (check_linear_pattern_variables p) +in (FStar_All.pipe_left Prims.ignore _160_343)) in ((env), (b), (p))) end))))))))) and desugar_binding_pat_maybe_top : Prims.bool -> FStar_Parser_Env.env -> FStar_Parser_AST.pattern -> Prims.bool -> (env_t * bnd * FStar_Syntax_Syntax.pat Prims.option) = (fun top env p is_mut -> ( -let mklet = (fun x -> (let _160_342 = (let _160_341 = (let _160_340 = (FStar_Parser_Env.qualify env x) -in ((_160_340), (FStar_Syntax_Syntax.tun))) -in LetBinder (_160_341)) -in ((env), (_160_342), (None)))) +let mklet = (fun x -> (let _160_352 = (let _160_351 = (let _160_350 = (FStar_Parser_Env.qualify env x) +in ((_160_350), (FStar_Syntax_Syntax.tun))) +in LetBinder (_160_351)) +in ((env), (_160_352), (None)))) in if top then begin (match (p.FStar_Parser_AST.pat) with | FStar_Parser_AST.PatOp (x) -> begin -(let _160_344 = (let _160_343 = (compile_op (Prims.parse_int "0") x) -in (FStar_Ident.id_of_text _160_343)) -in (mklet _160_344)) +(let _160_354 = (let _160_353 = (compile_op (Prims.parse_int "0") x) +in (FStar_Ident.id_of_text _160_353)) +in (mklet _160_354)) end -| FStar_Parser_AST.PatVar (x, _65_824) -> begin +| FStar_Parser_AST.PatVar (x, _65_834) -> begin (mklet x) end -| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (x, _65_831); FStar_Parser_AST.prange = _65_828}, t) -> begin -(let _160_348 = (let _160_347 = (let _160_346 = (FStar_Parser_Env.qualify env x) -in (let _160_345 = (desugar_term env t) -in ((_160_346), (_160_345)))) -in LetBinder (_160_347)) -in ((env), (_160_348), (None))) +| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (x, _65_841); FStar_Parser_AST.prange = _65_838}, t) -> begin +(let _160_358 = (let _160_357 = (let _160_356 = (FStar_Parser_Env.qualify env x) +in (let _160_355 = (desugar_term env t) +in ((_160_356), (_160_355)))) +in LetBinder (_160_357)) +in ((env), (_160_358), (None))) end -| _65_839 -> begin +| _65_849 -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected pattern at the top-level"), (p.FStar_Parser_AST.prange))))) end) end else begin ( -let _65_843 = (desugar_data_pat env p is_mut) -in (match (_65_843) with +let _65_853 = (desugar_data_pat env p is_mut) +in (match (_65_853) with | (env, binder, p) -> begin ( @@ -1128,18 +1134,18 @@ let p = (match (p.FStar_Syntax_Syntax.v) with | (FStar_Syntax_Syntax.Pat_var (_)) | (FStar_Syntax_Syntax.Pat_wild (_)) -> begin None end -| _65_851 -> begin +| _65_861 -> begin Some (p) end) in ((env), (binder), (p))) end)) end)) and desugar_binding_pat : FStar_Parser_Env.env -> FStar_Parser_AST.pattern -> (env_t * bnd * FStar_Syntax_Syntax.pat Prims.option) = (fun env p -> (desugar_binding_pat_maybe_top false env p false)) -and desugar_match_pat_maybe_top : Prims.bool -> FStar_Parser_Env.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Syntax_Syntax.pat) = (fun _65_855 env pat -> ( +and desugar_match_pat_maybe_top : Prims.bool -> FStar_Parser_Env.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Syntax_Syntax.pat) = (fun _65_865 env pat -> ( -let _65_863 = (desugar_data_pat env pat false) -in (match (_65_863) with -| (env, _65_861, pat) -> begin +let _65_873 = (desugar_data_pat env pat false) +in (match (_65_873) with +| (env, _65_871, pat) -> begin ((env), (pat)) end))) and desugar_match_pat : FStar_Parser_Env.env -> FStar_Parser_AST.pattern -> (env_t * FStar_Syntax_Syntax.pat) = (fun env p -> (desugar_match_pat_maybe_top false env p)) @@ -1147,17 +1153,17 @@ and desugar_term : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Sy let env = ( -let _65_868 = env -in {FStar_Parser_Env.curmodule = _65_868.FStar_Parser_Env.curmodule; FStar_Parser_Env.modules = _65_868.FStar_Parser_Env.modules; FStar_Parser_Env.open_namespaces = _65_868.FStar_Parser_Env.open_namespaces; FStar_Parser_Env.modul_abbrevs = _65_868.FStar_Parser_Env.modul_abbrevs; FStar_Parser_Env.sigaccum = _65_868.FStar_Parser_Env.sigaccum; FStar_Parser_Env.localbindings = _65_868.FStar_Parser_Env.localbindings; FStar_Parser_Env.recbindings = _65_868.FStar_Parser_Env.recbindings; FStar_Parser_Env.sigmap = _65_868.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_868.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_868.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_868.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = false}) +let _65_878 = env +in {FStar_Parser_Env.curmodule = _65_878.FStar_Parser_Env.curmodule; FStar_Parser_Env.curmonad = _65_878.FStar_Parser_Env.curmonad; FStar_Parser_Env.modules = _65_878.FStar_Parser_Env.modules; FStar_Parser_Env.scope_mods = _65_878.FStar_Parser_Env.scope_mods; FStar_Parser_Env.sigaccum = _65_878.FStar_Parser_Env.sigaccum; FStar_Parser_Env.sigmap = _65_878.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_878.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_878.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_878.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = false}) in (desugar_term_maybe_top false env e))) and desugar_typ : FStar_Parser_Env.env -> FStar_Parser_AST.term -> FStar_Syntax_Syntax.term = (fun env e -> ( let env = ( -let _65_873 = env -in {FStar_Parser_Env.curmodule = _65_873.FStar_Parser_Env.curmodule; FStar_Parser_Env.modules = _65_873.FStar_Parser_Env.modules; FStar_Parser_Env.open_namespaces = _65_873.FStar_Parser_Env.open_namespaces; FStar_Parser_Env.modul_abbrevs = _65_873.FStar_Parser_Env.modul_abbrevs; FStar_Parser_Env.sigaccum = _65_873.FStar_Parser_Env.sigaccum; FStar_Parser_Env.localbindings = _65_873.FStar_Parser_Env.localbindings; FStar_Parser_Env.recbindings = _65_873.FStar_Parser_Env.recbindings; FStar_Parser_Env.sigmap = _65_873.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_873.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_873.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_873.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = true}) +let _65_883 = env +in {FStar_Parser_Env.curmodule = _65_883.FStar_Parser_Env.curmodule; FStar_Parser_Env.curmonad = _65_883.FStar_Parser_Env.curmonad; FStar_Parser_Env.modules = _65_883.FStar_Parser_Env.modules; FStar_Parser_Env.scope_mods = _65_883.FStar_Parser_Env.scope_mods; FStar_Parser_Env.sigaccum = _65_883.FStar_Parser_Env.sigaccum; FStar_Parser_Env.sigmap = _65_883.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_883.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_883.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_883.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = true}) in (desugar_term_maybe_top false env e))) -and desugar_machine_integer : FStar_Parser_Env.env -> Prims.string -> (FStar_Const.signedness * FStar_Const.width) -> FStar_Range.range -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun env repr _65_880 range -> (match (_65_880) with +and desugar_machine_integer : FStar_Parser_Env.env -> Prims.string -> (FStar_Const.signedness * FStar_Const.width) -> FStar_Range.range -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun env repr _65_890 range -> (match (_65_890) with | (signedness, width) -> begin ( @@ -1196,19 +1202,36 @@ let lid = (match ((FStar_Parser_Env.try_lookup_lid env lid)) with (Prims.fst lid) end | None -> begin -(let _160_364 = (FStar_Util.format1 "%s not in scope\n" (FStar_Ident.text_of_lid lid)) -in (FStar_All.failwith _160_364)) +(let _160_374 = (FStar_Util.format1 "%s not in scope\n" (FStar_Ident.text_of_lid lid)) +in (FStar_All.failwith _160_374)) end) in ( let repr = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_int (((repr), (None))))) None range) -in (let _160_369 = (let _160_368 = (let _160_367 = (let _160_366 = (let _160_365 = (FStar_Syntax_Syntax.as_implicit false) -in ((repr), (_160_365))) -in (_160_366)::[]) -in ((lid), (_160_367))) -in FStar_Syntax_Syntax.Tm_app (_160_368)) -in (FStar_Syntax_Syntax.mk _160_369 None range)))))) +in (let _160_379 = (let _160_378 = (let _160_377 = (let _160_376 = (let _160_375 = (FStar_Syntax_Syntax.as_implicit false) +in ((repr), (_160_375))) +in (_160_376)::[]) +in ((lid), (_160_377))) +in FStar_Syntax_Syntax.Tm_app (_160_378)) +in (FStar_Syntax_Syntax.mk _160_379 None range)))))) end)) +and desugar_name : (FStar_Syntax_Syntax.term' -> FStar_Syntax_Syntax.term) -> (FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax) -> env_t -> FStar_Ident.lid -> FStar_Syntax_Syntax.term = (fun mk setpos env l -> ( + +let _65_913 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) l) +in (match (_65_913) with +| (tm, mut) -> begin +( + +let tm = (setpos tm) +in if mut then begin +(let _160_392 = (let _160_391 = (let _160_390 = (mk_ref_read tm) +in ((_160_390), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Mutable_rval)))) +in FStar_Syntax_Syntax.Tm_meta (_160_391)) +in (FStar_All.pipe_left mk _160_392)) +end else begin +tm +end) +end))) and desugar_term_maybe_top : Prims.bool -> env_t -> FStar_Parser_AST.term -> FStar_Syntax_Syntax.term = (fun top_level env top -> ( let mk = (fun e -> (FStar_Syntax_Syntax.mk e None top.FStar_Parser_AST.range)) @@ -1216,14 +1239,14 @@ in ( let setpos = (fun e -> ( -let _65_904 = e -in {FStar_Syntax_Syntax.n = _65_904.FStar_Syntax_Syntax.n; FStar_Syntax_Syntax.tk = _65_904.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = top.FStar_Parser_AST.range; FStar_Syntax_Syntax.vars = _65_904.FStar_Syntax_Syntax.vars})) -in (match ((let _160_377 = (unparen top) -in _160_377.FStar_Parser_AST.tm)) with +let _65_922 = e +in {FStar_Syntax_Syntax.n = _65_922.FStar_Syntax_Syntax.n; FStar_Syntax_Syntax.tk = _65_922.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = top.FStar_Parser_AST.range; FStar_Syntax_Syntax.vars = _65_922.FStar_Syntax_Syntax.vars})) +in (match ((let _160_400 = (unparen top) +in _160_400.FStar_Parser_AST.tm)) with | FStar_Parser_AST.Wild -> begin (setpos FStar_Syntax_Syntax.tun) end -| FStar_Parser_AST.Labeled (_65_908) -> begin +| FStar_Parser_AST.Labeled (_65_926) -> begin (desugar_formula env top) end | FStar_Parser_AST.Requires (t, lopt) -> begin @@ -1241,37 +1264,37 @@ end | FStar_Parser_AST.Op ("=!=", args) -> begin (desugar_term env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Op ((("~"), (((FStar_Parser_AST.mk_term (FStar_Parser_AST.Op ((("=="), (args)))) top.FStar_Parser_AST.range top.FStar_Parser_AST.level))::[])))) top.FStar_Parser_AST.range top.FStar_Parser_AST.level)) end -| FStar_Parser_AST.Op ("*", (_65_934)::(_65_932)::[]) when (let _160_378 = (op_as_term env (Prims.parse_int "2") top.FStar_Parser_AST.range "*") -in (FStar_All.pipe_right _160_378 FStar_Option.isNone)) -> begin +| FStar_Parser_AST.Op ("*", (_65_952)::(_65_950)::[]) when (let _160_401 = (op_as_term env (Prims.parse_int "2") top.FStar_Parser_AST.range "*") +in (FStar_All.pipe_right _160_401 FStar_Option.isNone)) -> begin ( let rec flatten = (fun t -> (match (t.FStar_Parser_AST.tm) with | FStar_Parser_AST.Op ("*", (t1)::(t2)::[]) -> begin -(let _160_381 = (flatten t1) -in (FStar_List.append _160_381 ((t2)::[]))) +(let _160_404 = (flatten t1) +in (FStar_List.append _160_404 ((t2)::[]))) end -| _65_947 -> begin +| _65_965 -> begin (t)::[] end)) in ( -let targs = (let _160_385 = (let _160_382 = (unparen top) -in (flatten _160_382)) -in (FStar_All.pipe_right _160_385 (FStar_List.map (fun t -> (let _160_384 = (desugar_typ env t) -in (FStar_Syntax_Syntax.as_arg _160_384)))))) +let targs = (let _160_408 = (let _160_405 = (unparen top) +in (flatten _160_405)) +in (FStar_All.pipe_right _160_408 (FStar_List.map (fun t -> (let _160_407 = (desugar_typ env t) +in (FStar_Syntax_Syntax.as_arg _160_407)))))) in ( -let _65_953 = (let _160_386 = (FStar_Syntax_Util.mk_tuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) -in (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) _160_386)) -in (match (_65_953) with -| (tup, _65_952) -> begin +let _65_971 = (let _160_409 = (FStar_Syntax_Util.mk_tuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) +in (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) _160_409)) +in (match (_65_971) with +| (tup, _65_970) -> begin (mk (FStar_Syntax_Syntax.Tm_app (((tup), (targs))))) end)))) end | FStar_Parser_AST.Tvar (a) -> begin -(let _160_388 = (let _160_387 = (FStar_Parser_Env.fail_or2 (FStar_Parser_Env.try_lookup_id env) a) -in (Prims.fst _160_387)) -in (FStar_All.pipe_left setpos _160_388)) +(let _160_411 = (let _160_410 = (FStar_Parser_Env.fail_or2 (FStar_Parser_Env.try_lookup_id env) a) +in (Prims.fst _160_410)) +in (FStar_All.pipe_left setpos _160_411)) end | FStar_Parser_AST.Op (s, args) -> begin (match ((op_as_term env (FStar_List.length args) top.FStar_Parser_AST.range s)) with @@ -1282,36 +1305,34 @@ end if ((FStar_List.length args) > (Prims.parse_int "0")) then begin ( -let args = (FStar_All.pipe_right args (FStar_List.map (fun t -> (let _160_390 = (desugar_term env t) -in ((_160_390), (None)))))) +let args = (FStar_All.pipe_right args (FStar_List.map (fun t -> (let _160_413 = (desugar_term env t) +in ((_160_413), (None)))))) in (mk (FStar_Syntax_Syntax.Tm_app (((op), (args)))))) end else begin op end end) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_971; FStar_Ident.ident = _65_969; FStar_Ident.nsstr = _65_967; FStar_Ident.str = "Type0"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_989; FStar_Ident.ident = _65_987; FStar_Ident.nsstr = _65_985; FStar_Ident.str = "Type0"}) -> begin (mk (FStar_Syntax_Syntax.Tm_type (FStar_Syntax_Syntax.U_zero))) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_980; FStar_Ident.ident = _65_978; FStar_Ident.nsstr = _65_976; FStar_Ident.str = "Type"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_998; FStar_Ident.ident = _65_996; FStar_Ident.nsstr = _65_994; FStar_Ident.str = "Type"}) -> begin (mk (FStar_Syntax_Syntax.Tm_type (FStar_Syntax_Syntax.U_unknown))) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_989; FStar_Ident.ident = _65_987; FStar_Ident.nsstr = _65_985; FStar_Ident.str = "Effect"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_1007; FStar_Ident.ident = _65_1005; FStar_Ident.nsstr = _65_1003; FStar_Ident.str = "Effect"}) -> begin (mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_effect))) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_998; FStar_Ident.ident = _65_996; FStar_Ident.nsstr = _65_994; FStar_Ident.str = "True"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_1016; FStar_Ident.ident = _65_1014; FStar_Ident.nsstr = _65_1012; FStar_Ident.str = "True"}) -> begin (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Syntax_Const.true_lid top.FStar_Parser_AST.range) FStar_Syntax_Syntax.Delta_constant None) end -| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_1007; FStar_Ident.ident = _65_1005; FStar_Ident.nsstr = _65_1003; FStar_Ident.str = "False"}) -> begin +| FStar_Parser_AST.Name ({FStar_Ident.ns = _65_1025; FStar_Ident.ident = _65_1023; FStar_Ident.nsstr = _65_1021; FStar_Ident.str = "False"}) -> begin (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Syntax_Const.false_lid top.FStar_Parser_AST.range) FStar_Syntax_Syntax.Delta_constant None) end -| FStar_Parser_AST.Var ({FStar_Ident.ns = (eff)::rest; FStar_Ident.ident = {FStar_Ident.idText = txt; FStar_Ident.idRange = _65_1015}; FStar_Ident.nsstr = _65_1013; FStar_Ident.str = _65_1011}) when ((is_special_effect_combinator txt) && (let _160_391 = (FStar_Ident.lid_of_ids ((eff)::rest)) -in (FStar_Parser_Env.is_effect_name env _160_391))) -> begin -(match ((let _160_392 = (FStar_Ident.lid_of_ids ((eff)::rest)) -in (FStar_Parser_Env.try_lookup_effect_defn env _160_392))) with +| FStar_Parser_AST.Projector (eff_name, {FStar_Ident.idText = txt; FStar_Ident.idRange = _65_1030}) when ((is_special_effect_combinator txt) && (FStar_Parser_Env.is_effect_name env eff_name)) -> begin +(match ((FStar_Parser_Env.try_lookup_effect_defn env eff_name)) with | Some (ed) -> begin -(let _160_393 = (FStar_Ident.lid_of_path (FStar_Ident.path_of_text (Prims.strcat (FStar_Ident.text_of_lid ed.FStar_Syntax_Syntax.mname) (Prims.strcat "_" txt))) FStar_Range.dummyRange) -in (FStar_Syntax_Syntax.fvar _160_393 (FStar_Syntax_Syntax.Delta_defined_at_level ((Prims.parse_int "1"))) None)) +(let _160_414 = (FStar_Ident.lid_of_path (FStar_Ident.path_of_text (Prims.strcat (FStar_Ident.text_of_lid ed.FStar_Syntax_Syntax.mname) (Prims.strcat "_" txt))) FStar_Range.dummyRange) +in (FStar_Syntax_Syntax.fvar _160_414 (FStar_Syntax_Syntax.Delta_defined_at_level ((Prims.parse_int "1"))) None)) end | None -> begin (FStar_All.failwith "immpossible special_effect_combinator") @@ -1323,12 +1344,12 @@ end let t2 = (desugar_term env t2) in ( -let _65_1033 = (FStar_Parser_Env.fail_or2 (FStar_Parser_Env.try_lookup_id env) ident) -in (match (_65_1033) with +let _65_1045 = (FStar_Parser_Env.fail_or2 (FStar_Parser_Env.try_lookup_id env) ident) +in (match (_65_1045) with | (t1, mut) -> begin ( -let _65_1034 = if (not (mut)) then begin +let _65_1046 = if (not (mut)) then begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Can only assign to mutable values"), (top.FStar_Parser_AST.range))))) end else begin () @@ -1337,41 +1358,56 @@ in (mk_ref_assign t1 t2 top.FStar_Parser_AST.range)) end))) end | (FStar_Parser_AST.Var (l)) | (FStar_Parser_AST.Name (l)) -> begin +(desugar_name mk setpos env l) +end +| FStar_Parser_AST.Projector (l, i) -> begin ( -let _65_1041 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) l) -in (match (_65_1041) with -| (tm, mut) -> begin +let found = ((let _160_415 = (FStar_Parser_Env.try_lookup_datacon env l) +in (FStar_Option.isSome _160_415)) || (let _160_416 = (FStar_Parser_Env.try_lookup_effect_defn env l) +in (FStar_Option.isSome _160_416))) +in if found then begin +(let _160_417 = (FStar_Syntax_Util.mk_field_projector_name_from_ident l i) +in (desugar_name mk setpos env _160_417)) +end else begin +(let _160_420 = (let _160_419 = (let _160_418 = (FStar_Util.format1 "Data constructor or effect %s not found" l.FStar_Ident.str) +in ((_160_418), (top.FStar_Parser_AST.range))) +in FStar_Syntax_Syntax.Error (_160_419)) +in (Prims.raise _160_420)) +end) +end +| FStar_Parser_AST.Discrim (lid) -> begin +(match ((FStar_Parser_Env.try_lookup_datacon env lid)) with +| None -> begin +(let _160_423 = (let _160_422 = (let _160_421 = (FStar_Util.format1 "Data constructor %s not found" lid.FStar_Ident.str) +in ((_160_421), (top.FStar_Parser_AST.range))) +in FStar_Syntax_Syntax.Error (_160_422)) +in (Prims.raise _160_423)) +end +| _65_1060 -> begin ( -let tm = (setpos tm) -in if mut then begin -(let _160_396 = (let _160_395 = (let _160_394 = (mk_ref_read tm) -in ((_160_394), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Mutable_rval)))) -in FStar_Syntax_Syntax.Tm_meta (_160_395)) -in (FStar_All.pipe_left mk _160_396)) -end else begin -tm +let lid' = (FStar_Syntax_Util.mk_discriminator lid) +in (desugar_name mk setpos env lid')) end) -end)) end | FStar_Parser_AST.Construct (l, args) -> begin (match ((FStar_Parser_Env.try_lookup_datacon env l)) with | Some (head) -> begin ( -let _65_1051 = (let _160_397 = (mk (FStar_Syntax_Syntax.Tm_fvar (head))) -in ((_160_397), (true))) -in (match (_65_1051) with +let _65_1070 = (let _160_424 = (mk (FStar_Syntax_Syntax.Tm_fvar (head))) +in ((_160_424), (true))) +in (match (_65_1070) with | (head, is_data) -> begin (match (args) with | [] -> begin head end -| _65_1054 -> begin +| _65_1073 -> begin ( -let args = (FStar_List.map (fun _65_1057 -> (match (_65_1057) with +let args = (FStar_List.map (fun _65_1076 -> (match (_65_1076) with | (t, imp) -> begin ( @@ -1390,62 +1426,50 @@ end) end)) end | None -> begin -( - -let l = (FStar_Parser_Env.expand_module_abbrev env l) -in ( - -let env = (FStar_Parser_Env.push_namespace env l) -in (match (args) with -| ((e, _65_1066))::[] -> begin -(desugar_term_maybe_top top_level env e) -end -| _65_1070 -> begin -(Prims.raise (FStar_Syntax_Syntax.Error ((("The Foo.Bar (...) local open takes exactly one argument"), (top.FStar_Parser_AST.range))))) -end))) +(Prims.raise (FStar_Syntax_Syntax.Error ((((Prims.strcat "Constructor " (Prims.strcat l.FStar_Ident.str " not found"))), (top.FStar_Parser_AST.range))))) end) end | FStar_Parser_AST.Sum (binders, t) -> begin ( -let _65_1095 = (FStar_List.fold_left (fun _65_1078 b -> (match (_65_1078) with +let _65_1105 = (FStar_List.fold_left (fun _65_1088 b -> (match (_65_1088) with | (env, tparams, typs) -> begin ( -let _65_1082 = (desugar_binder env b) -in (match (_65_1082) with +let _65_1092 = (desugar_binder env b) +in (match (_65_1092) with | (xopt, t) -> begin ( -let _65_1088 = (match (xopt) with +let _65_1098 = (match (xopt) with | None -> begin -(let _160_401 = (FStar_Syntax_Syntax.new_bv (Some (top.FStar_Parser_AST.range)) FStar_Syntax_Syntax.tun) -in ((env), (_160_401))) +(let _160_428 = (FStar_Syntax_Syntax.new_bv (Some (top.FStar_Parser_AST.range)) FStar_Syntax_Syntax.tun) +in ((env), (_160_428))) end | Some (x) -> begin (FStar_Parser_Env.push_bv env x) end) -in (match (_65_1088) with +in (match (_65_1098) with | (env, x) -> begin -(let _160_405 = (let _160_404 = (let _160_403 = (let _160_402 = (no_annot_abs tparams t) -in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_402)) -in (_160_403)::[]) -in (FStar_List.append typs _160_404)) +(let _160_432 = (let _160_431 = (let _160_430 = (let _160_429 = (no_annot_abs tparams t) +in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_429)) +in (_160_430)::[]) +in (FStar_List.append typs _160_431)) in ((env), ((FStar_List.append tparams ((((( -let _65_1089 = x -in {FStar_Syntax_Syntax.ppname = _65_1089.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1089.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = t})), (None)))::[]))), (_160_405))) +let _65_1099 = x +in {FStar_Syntax_Syntax.ppname = _65_1099.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1099.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = t})), (None)))::[]))), (_160_432))) end)) end)) end)) ((env), ([]), ([])) (FStar_List.append binders (((FStar_Parser_AST.mk_binder (FStar_Parser_AST.NoName (t)) t.FStar_Parser_AST.range FStar_Parser_AST.Type None))::[]))) -in (match (_65_1095) with -| (env, _65_1093, targs) -> begin +in (match (_65_1105) with +| (env, _65_1103, targs) -> begin ( -let _65_1099 = (let _160_406 = (FStar_Syntax_Util.mk_dtuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) -in (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) _160_406)) -in (match (_65_1099) with -| (tup, _65_1098) -> begin +let _65_1109 = (let _160_433 = (FStar_Syntax_Util.mk_dtuple_lid (FStar_List.length targs) top.FStar_Parser_AST.range) +in (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) _160_433)) +in (match (_65_1109) with +| (tup, _65_1108) -> begin (FStar_All.pipe_left mk (FStar_Syntax_Syntax.Tm_app (((tup), (targs))))) end)) end)) @@ -1453,8 +1477,8 @@ end | FStar_Parser_AST.Product (binders, t) -> begin ( -let _65_1106 = (uncurry binders t) -in (match (_65_1106) with +let _65_1116 = (uncurry binders t) +in (match (_65_1116) with | (bs, t) -> begin ( @@ -1463,8 +1487,8 @@ let rec aux = (fun env bs _65_9 -> (match (_65_9) with ( let cod = (desugar_comp top.FStar_Parser_AST.range true env t) -in (let _160_413 = (FStar_Syntax_Util.arrow (FStar_List.rev bs) cod) -in (FStar_All.pipe_left setpos _160_413))) +in (let _160_440 = (FStar_Syntax_Util.arrow (FStar_List.rev bs) cod) +in (FStar_All.pipe_left setpos _160_440))) end | (hd)::tl -> begin ( @@ -1475,8 +1499,8 @@ in ( let bb = (desugar_binder mlenv hd) in ( -let _65_1120 = (as_binder env hd.FStar_Parser_AST.aqual bb) -in (match (_65_1120) with +let _65_1130 = (as_binder env hd.FStar_Parser_AST.aqual bb) +in (match (_65_1130) with | (b, env) -> begin (aux env ((b)::bs) tl) end)))) @@ -1486,20 +1510,20 @@ end)) end | FStar_Parser_AST.Refine (b, f) -> begin (match ((desugar_binder env b)) with -| (None, _65_1127) -> begin +| (None, _65_1137) -> begin (FStar_All.failwith "Missing binder in refinement") end | b -> begin ( -let _65_1135 = (as_binder env None b) -in (match (_65_1135) with -| ((x, _65_1132), env) -> begin +let _65_1145 = (as_binder env None b) +in (match (_65_1145) with +| ((x, _65_1142), env) -> begin ( let f = (desugar_formula env f) -in (let _160_414 = (FStar_Syntax_Util.refine x f) -in (FStar_All.pipe_left setpos _160_414))) +in (let _160_441 = (FStar_Syntax_Util.refine x f) +in (FStar_All.pipe_left setpos _160_441))) end)) end) end @@ -1509,27 +1533,27 @@ end let binders = (FStar_All.pipe_right binders (FStar_List.map replace_unit_pattern)) in ( -let _65_1156 = (FStar_List.fold_left (fun _65_1144 pat -> (match (_65_1144) with +let _65_1166 = (FStar_List.fold_left (fun _65_1154 pat -> (match (_65_1154) with | (env, ftvs) -> begin (match (pat.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed (_65_1147, t) -> begin -(let _160_418 = (let _160_417 = (free_type_vars env t) -in (FStar_List.append _160_417 ftvs)) -in ((env), (_160_418))) +| FStar_Parser_AST.PatAscribed (_65_1157, t) -> begin +(let _160_445 = (let _160_444 = (free_type_vars env t) +in (FStar_List.append _160_444 ftvs)) +in ((env), (_160_445))) end -| _65_1152 -> begin +| _65_1162 -> begin ((env), (ftvs)) end) end)) ((env), ([])) binders) -in (match (_65_1156) with -| (_65_1154, ftv) -> begin +in (match (_65_1166) with +| (_65_1164, ftv) -> begin ( let ftv = (sort_ftv ftv) in ( -let binders = (let _160_420 = (FStar_All.pipe_right ftv (FStar_List.map (fun a -> (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatTvar (((a), (Some (FStar_Parser_AST.Implicit))))) top.FStar_Parser_AST.range)))) -in (FStar_List.append _160_420 binders)) +let binders = (let _160_447 = (FStar_All.pipe_right ftv (FStar_List.map (fun a -> (FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatTvar (((a), (Some (FStar_Parser_AST.Implicit))))) top.FStar_Parser_AST.range)))) +in (FStar_List.append _160_447 binders)) in ( let rec aux = (fun env bs sc_pat_opt _65_10 -> (match (_65_10) with @@ -1543,93 +1567,93 @@ let body = (match (sc_pat_opt) with | Some (sc, pat) -> begin ( -let body = (let _160_430 = (let _160_429 = (FStar_Syntax_Syntax.pat_bvs pat) -in (FStar_All.pipe_right _160_429 (FStar_List.map FStar_Syntax_Syntax.mk_binder))) -in (FStar_Syntax_Subst.close _160_430 body)) +let body = (let _160_457 = (let _160_456 = (FStar_Syntax_Syntax.pat_bvs pat) +in (FStar_All.pipe_right _160_456 (FStar_List.map FStar_Syntax_Syntax.mk_binder))) +in (FStar_Syntax_Subst.close _160_457 body)) in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_match (((sc), ((((pat), (None), (body)))::[])))) None body.FStar_Syntax_Syntax.pos)) end | None -> begin body end) -in (let _160_431 = (no_annot_abs (FStar_List.rev bs) body) -in (setpos _160_431)))) +in (let _160_458 = (no_annot_abs (FStar_List.rev bs) body) +in (setpos _160_458)))) end | (p)::rest -> begin ( -let _65_1180 = (desugar_binding_pat env p) -in (match (_65_1180) with +let _65_1190 = (desugar_binding_pat env p) +in (match (_65_1190) with | (env, b, pat) -> begin ( -let _65_1231 = (match (b) with -| LetBinder (_65_1182) -> begin +let _65_1241 = (match (b) with +| LetBinder (_65_1192) -> begin (FStar_All.failwith "Impossible") end | LocalBinder (x, aq) -> begin ( let sc_pat_opt = (match (((pat), (sc_pat_opt))) with -| (None, _65_1190) -> begin +| (None, _65_1200) -> begin sc_pat_opt end | (Some (p), None) -> begin -(let _160_433 = (let _160_432 = (FStar_Syntax_Syntax.bv_to_name x) -in ((_160_432), (p))) -in Some (_160_433)) +(let _160_460 = (let _160_459 = (FStar_Syntax_Syntax.bv_to_name x) +in ((_160_459), (p))) +in Some (_160_460)) end | (Some (p), Some (sc, p')) -> begin (match (((sc.FStar_Syntax_Syntax.n), (p'.FStar_Syntax_Syntax.v))) with -| (FStar_Syntax_Syntax.Tm_name (_65_1204), _65_1207) -> begin +| (FStar_Syntax_Syntax.Tm_name (_65_1214), _65_1217) -> begin ( -let tup2 = (let _160_434 = (FStar_Syntax_Util.mk_tuple_data_lid (Prims.parse_int "2") top.FStar_Parser_AST.range) -in (FStar_Syntax_Syntax.lid_as_fv _160_434 FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor)))) +let tup2 = (let _160_461 = (FStar_Syntax_Util.mk_tuple_data_lid (Prims.parse_int "2") top.FStar_Parser_AST.range) +in (FStar_Syntax_Syntax.lid_as_fv _160_461 FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor)))) in ( -let sc = (let _160_442 = (let _160_441 = (let _160_440 = (mk (FStar_Syntax_Syntax.Tm_fvar (tup2))) -in (let _160_439 = (let _160_438 = (FStar_Syntax_Syntax.as_arg sc) -in (let _160_437 = (let _160_436 = (let _160_435 = (FStar_Syntax_Syntax.bv_to_name x) -in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_435)) -in (_160_436)::[]) -in (_160_438)::_160_437)) -in ((_160_440), (_160_439)))) -in FStar_Syntax_Syntax.Tm_app (_160_441)) -in (FStar_Syntax_Syntax.mk _160_442 None top.FStar_Parser_AST.range)) +let sc = (let _160_469 = (let _160_468 = (let _160_467 = (mk (FStar_Syntax_Syntax.Tm_fvar (tup2))) +in (let _160_466 = (let _160_465 = (FStar_Syntax_Syntax.as_arg sc) +in (let _160_464 = (let _160_463 = (let _160_462 = (FStar_Syntax_Syntax.bv_to_name x) +in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_462)) +in (_160_463)::[]) +in (_160_465)::_160_464)) +in ((_160_467), (_160_466)))) +in FStar_Syntax_Syntax.Tm_app (_160_468)) +in (FStar_Syntax_Syntax.mk _160_469 None top.FStar_Parser_AST.range)) in ( -let p = (let _160_443 = (FStar_Range.union_ranges p'.FStar_Syntax_Syntax.p p.FStar_Syntax_Syntax.p) -in (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_cons (((tup2), ((((p'), (false)))::(((p), (false)))::[])))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n _160_443)) +let p = (let _160_470 = (FStar_Range.union_ranges p'.FStar_Syntax_Syntax.p p.FStar_Syntax_Syntax.p) +in (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_cons (((tup2), ((((p'), (false)))::(((p), (false)))::[])))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n _160_470)) in Some (((sc), (p)))))) end -| (FStar_Syntax_Syntax.Tm_app (_65_1213, args), FStar_Syntax_Syntax.Pat_cons (_65_1218, pats)) -> begin +| (FStar_Syntax_Syntax.Tm_app (_65_1223, args), FStar_Syntax_Syntax.Pat_cons (_65_1228, pats)) -> begin ( -let tupn = (let _160_444 = (FStar_Syntax_Util.mk_tuple_data_lid ((Prims.parse_int "1") + (FStar_List.length args)) top.FStar_Parser_AST.range) -in (FStar_Syntax_Syntax.lid_as_fv _160_444 FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor)))) +let tupn = (let _160_471 = (FStar_Syntax_Util.mk_tuple_data_lid ((Prims.parse_int "1") + (FStar_List.length args)) top.FStar_Parser_AST.range) +in (FStar_Syntax_Syntax.lid_as_fv _160_471 FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor)))) in ( -let sc = (let _160_451 = (let _160_450 = (let _160_449 = (mk (FStar_Syntax_Syntax.Tm_fvar (tupn))) -in (let _160_448 = (let _160_447 = (let _160_446 = (let _160_445 = (FStar_Syntax_Syntax.bv_to_name x) -in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_445)) -in (_160_446)::[]) -in (FStar_List.append args _160_447)) -in ((_160_449), (_160_448)))) -in FStar_Syntax_Syntax.Tm_app (_160_450)) -in (mk _160_451)) +let sc = (let _160_478 = (let _160_477 = (let _160_476 = (mk (FStar_Syntax_Syntax.Tm_fvar (tupn))) +in (let _160_475 = (let _160_474 = (let _160_473 = (let _160_472 = (FStar_Syntax_Syntax.bv_to_name x) +in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_472)) +in (_160_473)::[]) +in (FStar_List.append args _160_474)) +in ((_160_476), (_160_475)))) +in FStar_Syntax_Syntax.Tm_app (_160_477)) +in (mk _160_478)) in ( -let p = (let _160_452 = (FStar_Range.union_ranges p'.FStar_Syntax_Syntax.p p.FStar_Syntax_Syntax.p) -in (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_cons (((tupn), ((FStar_List.append pats ((((p), (false)))::[])))))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n _160_452)) +let p = (let _160_479 = (FStar_Range.union_ranges p'.FStar_Syntax_Syntax.p p.FStar_Syntax_Syntax.p) +in (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_cons (((tupn), ((FStar_List.append pats ((((p), (false)))::[])))))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n _160_479)) in Some (((sc), (p)))))) end -| _65_1227 -> begin +| _65_1237 -> begin (FStar_All.failwith "Impossible") end) end) in ((((x), (aq))), (sc_pat_opt))) end) -in (match (_65_1231) with +in (match (_65_1241) with | (b, sc_pat_opt) -> begin (aux env ((b)::bs) sc_pat_opt rest) end)) @@ -1638,36 +1662,36 @@ end)) in (aux env [] None binders)))) end))) end -| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (a); FStar_Parser_AST.range = rng; FStar_Parser_AST.level = _65_1233}, phi, _65_1240) when ((FStar_Ident.lid_equals a FStar_Syntax_Const.assert_lid) || (FStar_Ident.lid_equals a FStar_Syntax_Const.assume_lid)) -> begin +| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (a); FStar_Parser_AST.range = rng; FStar_Parser_AST.level = _65_1243}, phi, _65_1250) when ((FStar_Ident.lid_equals a FStar_Syntax_Const.assert_lid) || (FStar_Ident.lid_equals a FStar_Syntax_Const.assume_lid)) -> begin ( let phi = (desugar_formula env phi) in ( let a = (FStar_Ident.set_lid_range a rng) -in (let _160_460 = (let _160_459 = (let _160_458 = (FStar_Syntax_Syntax.fvar a FStar_Syntax_Syntax.Delta_equational None) -in (let _160_457 = (let _160_456 = (FStar_Syntax_Syntax.as_arg phi) -in (let _160_455 = (let _160_454 = (let _160_453 = (mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_unit))) -in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_453)) -in (_160_454)::[]) -in (_160_456)::_160_455)) -in ((_160_458), (_160_457)))) -in FStar_Syntax_Syntax.Tm_app (_160_459)) -in (mk _160_460)))) +in (let _160_487 = (let _160_486 = (let _160_485 = (FStar_Syntax_Syntax.fvar a FStar_Syntax_Syntax.Delta_equational None) +in (let _160_484 = (let _160_483 = (FStar_Syntax_Syntax.as_arg phi) +in (let _160_482 = (let _160_481 = (let _160_480 = (mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_unit))) +in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_480)) +in (_160_481)::[]) +in (_160_483)::_160_482)) +in ((_160_485), (_160_484)))) +in FStar_Syntax_Syntax.Tm_app (_160_486)) +in (mk _160_487)))) end -| FStar_Parser_AST.App (_65_1246) -> begin +| FStar_Parser_AST.App (_65_1256) -> begin ( -let rec aux = (fun args e -> (match ((let _160_465 = (unparen e) -in _160_465.FStar_Parser_AST.tm)) with +let rec aux = (fun args e -> (match ((let _160_492 = (unparen e) +in _160_492.FStar_Parser_AST.tm)) with | FStar_Parser_AST.App (e, t, imp) -> begin ( -let arg = (let _160_466 = (desugar_term env t) -in (FStar_All.pipe_left (arg_withimp_e imp) _160_466)) +let arg = (let _160_493 = (desugar_term env t) +in (FStar_All.pipe_left (arg_withimp_e imp) _160_493)) in (aux ((arg)::args) e)) end -| _65_1258 -> begin +| _65_1268 -> begin ( let head = (desugar_term env e) @@ -1676,19 +1700,16 @@ end)) in (aux [] top)) end | FStar_Parser_AST.Seq (t1, t2) -> begin -(let _160_469 = (let _160_468 = (let _160_467 = (desugar_term env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild t1.FStar_Parser_AST.range)), (t1)))::[]), (t2)))) top.FStar_Parser_AST.range FStar_Parser_AST.Expr)) -in ((_160_467), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Sequence)))) -in FStar_Syntax_Syntax.Tm_meta (_160_468)) -in (mk _160_469)) +(let _160_496 = (let _160_495 = (let _160_494 = (desugar_term env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern FStar_Parser_AST.PatWild t1.FStar_Parser_AST.range)), (t1)))::[]), (t2)))) top.FStar_Parser_AST.range FStar_Parser_AST.Expr)) +in ((_160_494), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Sequence)))) +in FStar_Syntax_Syntax.Tm_meta (_160_495)) +in (mk _160_496)) end | FStar_Parser_AST.LetOpen (lid, e) -> begin ( -let lid = (FStar_Parser_Env.expand_module_abbrev env lid) -in ( - let env = (FStar_Parser_Env.push_namespace env lid) -in (desugar_term_maybe_top top_level env e))) +in (desugar_term_maybe_top top_level env e)) end | FStar_Parser_AST.Let (qual, ((pat, _snd))::_tl, body) -> begin ( @@ -1696,47 +1717,47 @@ end let is_rec = (qual = FStar_Parser_AST.Rec) in ( -let ds_let_rec_or_app = (fun _65_1281 -> (match (()) with +let ds_let_rec_or_app = (fun _65_1290 -> (match (()) with | () -> begin ( let bindings = (((pat), (_snd)))::_tl in ( -let funs = (FStar_All.pipe_right bindings (FStar_List.map (fun _65_1285 -> (match (_65_1285) with +let funs = (FStar_All.pipe_right bindings (FStar_List.map (fun _65_1294 -> (match (_65_1294) with | (p, def) -> begin if (is_app_pattern p) then begin -(let _160_473 = (destruct_app_pattern env top_level p) -in ((_160_473), (def))) +(let _160_500 = (destruct_app_pattern env top_level p) +in ((_160_500), (def))) end else begin (match ((FStar_Parser_AST.un_function p def)) with | Some (p, def) -> begin -(let _160_474 = (destruct_app_pattern env top_level p) -in ((_160_474), (def))) +(let _160_501 = (destruct_app_pattern env top_level p) +in ((_160_501), (def))) end -| _65_1291 -> begin +| _65_1300 -> begin (match (p.FStar_Parser_AST.pat) with -| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_1296); FStar_Parser_AST.prange = _65_1293}, t) -> begin +| FStar_Parser_AST.PatAscribed ({FStar_Parser_AST.pat = FStar_Parser_AST.PatVar (id, _65_1305); FStar_Parser_AST.prange = _65_1302}, t) -> begin if top_level then begin -(let _160_477 = (let _160_476 = (let _160_475 = (FStar_Parser_Env.qualify env id) -in FStar_Util.Inr (_160_475)) -in ((_160_476), ([]), (Some (t)))) -in ((_160_477), (def))) +(let _160_504 = (let _160_503 = (let _160_502 = (FStar_Parser_Env.qualify env id) +in FStar_Util.Inr (_160_502)) +in ((_160_503), ([]), (Some (t)))) +in ((_160_504), (def))) end else begin ((((FStar_Util.Inl (id)), ([]), (Some (t)))), (def)) end end -| FStar_Parser_AST.PatVar (id, _65_1305) -> begin +| FStar_Parser_AST.PatVar (id, _65_1314) -> begin if top_level then begin -(let _160_480 = (let _160_479 = (let _160_478 = (FStar_Parser_Env.qualify env id) -in FStar_Util.Inr (_160_478)) -in ((_160_479), ([]), (None))) -in ((_160_480), (def))) +(let _160_507 = (let _160_506 = (let _160_505 = (FStar_Parser_Env.qualify env id) +in FStar_Util.Inr (_160_505)) +in ((_160_506), ([]), (None))) +in ((_160_507), (def))) end else begin ((((FStar_Util.Inl (id)), ([]), (None))), (def)) end end -| _65_1309 -> begin +| _65_1318 -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected let binding"), (p.FStar_Parser_AST.prange))))) end) end) @@ -1744,40 +1765,40 @@ end end)))) in ( -let _65_1338 = (FStar_List.fold_left (fun _65_1314 _65_1323 -> (match (((_65_1314), (_65_1323))) with -| ((env, fnames, rec_bindings), ((f, _65_1317, _65_1319), _65_1322)) -> begin +let _65_1347 = (FStar_List.fold_left (fun _65_1323 _65_1332 -> (match (((_65_1323), (_65_1332))) with +| ((env, fnames, rec_bindings), ((f, _65_1326, _65_1328), _65_1331)) -> begin ( -let _65_1334 = (match (f) with +let _65_1343 = (match (f) with | FStar_Util.Inl (x) -> begin ( -let _65_1328 = (FStar_Parser_Env.push_bv env x) -in (match (_65_1328) with +let _65_1337 = (FStar_Parser_Env.push_bv env x) +in (match (_65_1337) with | (env, xx) -> begin -(let _160_484 = (let _160_483 = (FStar_Syntax_Syntax.mk_binder xx) -in (_160_483)::rec_bindings) -in ((env), (FStar_Util.Inl (xx)), (_160_484))) +(let _160_511 = (let _160_510 = (FStar_Syntax_Syntax.mk_binder xx) +in (_160_510)::rec_bindings) +in ((env), (FStar_Util.Inl (xx)), (_160_511))) end)) end | FStar_Util.Inr (l) -> begin -(let _160_485 = (FStar_Parser_Env.push_top_level_rec_binding env l.FStar_Ident.ident FStar_Syntax_Syntax.Delta_equational) -in ((_160_485), (FStar_Util.Inr (l)), (rec_bindings))) +(let _160_512 = (FStar_Parser_Env.push_top_level_rec_binding env l.FStar_Ident.ident FStar_Syntax_Syntax.Delta_equational) +in ((_160_512), (FStar_Util.Inr (l)), (rec_bindings))) end) -in (match (_65_1334) with +in (match (_65_1343) with | (env, lbname, rec_bindings) -> begin ((env), ((lbname)::fnames), (rec_bindings)) end)) end)) ((env), ([]), ([])) funs) -in (match (_65_1338) with +in (match (_65_1347) with | (env', fnames, rec_bindings) -> begin ( let fnames = (FStar_List.rev fnames) in ( -let desugar_one_def = (fun env lbname _65_1349 -> (match (_65_1349) with -| ((_65_1344, args, result_t), def) -> begin +let desugar_one_def = (fun env lbname _65_1358 -> (match (_65_1358) with +| ((_65_1353, args, result_t), def) -> begin ( let args = (FStar_All.pipe_right args (FStar_List.map replace_unit_pattern)) @@ -1790,7 +1811,7 @@ end | Some (t) -> begin ( -let _65_1358 = if (is_comp_type env t) then begin +let _65_1367 = if (is_comp_type env t) then begin (match ((FStar_All.pipe_right args (FStar_List.tryFind (fun x -> (not ((is_var_pattern x))))))) with | None -> begin () @@ -1801,8 +1822,8 @@ end) end else begin () end -in (let _160_493 = (FStar_Range.union_ranges t.FStar_Parser_AST.range def.FStar_Parser_AST.range) -in (FStar_Parser_AST.mk_term (FStar_Parser_AST.Ascribed (((def), (t)))) _160_493 FStar_Parser_AST.Expr))) +in (let _160_520 = (FStar_Range.union_ranges t.FStar_Parser_AST.range def.FStar_Parser_AST.range) +in (FStar_Parser_AST.mk_term (FStar_Parser_AST.Ascribed (((def), (t)))) _160_520 FStar_Parser_AST.Expr))) end) in ( @@ -1810,7 +1831,7 @@ let def = (match (args) with | [] -> begin def end -| _65_1363 -> begin +| _65_1372 -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.un_curry_abs args def) top.FStar_Parser_AST.range top.FStar_Parser_AST.level) end) in ( @@ -1823,9 +1844,9 @@ let lbname = (match (lbname) with FStar_Util.Inl (x) end | FStar_Util.Inr (l) -> begin -(let _160_495 = (let _160_494 = (FStar_Syntax_Util.incr_delta_qualifier body) -in (FStar_Syntax_Syntax.lid_as_fv l _160_494 None)) -in FStar_Util.Inr (_160_495)) +(let _160_522 = (let _160_521 = (FStar_Syntax_Util.incr_delta_qualifier body) +in (FStar_Syntax_Syntax.lid_as_fv l _160_521 None)) +in FStar_Util.Inr (_160_522)) end) in ( @@ -1846,10 +1867,10 @@ end)) fnames funs) in ( let body = (desugar_term env' body) -in (let _160_498 = (let _160_497 = (let _160_496 = (FStar_Syntax_Subst.close rec_bindings body) -in ((((is_rec), (lbs))), (_160_496))) -in FStar_Syntax_Syntax.Tm_let (_160_497)) -in (FStar_All.pipe_left mk _160_498)))))) +in (let _160_525 = (let _160_524 = (let _160_523 = (FStar_Syntax_Subst.close rec_bindings body) +in ((((is_rec), (lbs))), (_160_523))) +in FStar_Syntax_Syntax.Tm_let (_160_524)) +in (FStar_All.pipe_left mk _160_525)))))) end)))) end)) in ( @@ -1869,8 +1890,8 @@ t1 end in ( -let _65_1384 = (desugar_binding_pat_maybe_top top_level env pat is_mutable) -in (match (_65_1384) with +let _65_1393 = (desugar_binding_pat_maybe_top top_level env pat is_mutable) +in (match (_65_1393) with | (env, binder, pat) -> begin ( @@ -1881,11 +1902,11 @@ let tm = (match (binder) with let body = (desugar_term env t2) in ( -let fv = (let _160_505 = (FStar_Syntax_Util.incr_delta_qualifier t1) -in (FStar_Syntax_Syntax.lid_as_fv l _160_505 None)) +let fv = (let _160_532 = (FStar_Syntax_Util.incr_delta_qualifier t1) +in (FStar_Syntax_Syntax.lid_as_fv l _160_532 None)) in (FStar_All.pipe_left mk (FStar_Syntax_Syntax.Tm_let (((((false), (({FStar_Syntax_Syntax.lbname = FStar_Util.Inr (fv); FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_ALL_lid; FStar_Syntax_Syntax.lbdef = t1})::[]))), (body))))))) end -| LocalBinder (x, _65_1393) -> begin +| LocalBinder (x, _65_1402) -> begin ( let body = (desugar_term env t2) @@ -1896,19 +1917,19 @@ let body = (match (pat) with body end | Some (pat) -> begin -(let _160_510 = (let _160_509 = (let _160_508 = (FStar_Syntax_Syntax.bv_to_name x) -in (let _160_507 = (let _160_506 = (FStar_Syntax_Util.branch ((pat), (None), (body))) -in (_160_506)::[]) -in ((_160_508), (_160_507)))) -in FStar_Syntax_Syntax.Tm_match (_160_509)) -in (FStar_Syntax_Syntax.mk _160_510 None body.FStar_Syntax_Syntax.pos)) +(let _160_537 = (let _160_536 = (let _160_535 = (FStar_Syntax_Syntax.bv_to_name x) +in (let _160_534 = (let _160_533 = (FStar_Syntax_Util.branch ((pat), (None), (body))) +in (_160_533)::[]) +in ((_160_535), (_160_534)))) +in FStar_Syntax_Syntax.Tm_match (_160_536)) +in (FStar_Syntax_Syntax.mk _160_537 None body.FStar_Syntax_Syntax.pos)) end) -in (let _160_515 = (let _160_514 = (let _160_513 = (let _160_512 = (let _160_511 = (FStar_Syntax_Syntax.mk_binder x) -in (_160_511)::[]) -in (FStar_Syntax_Subst.close _160_512 body)) -in ((((false), (((mk_lb ((FStar_Util.Inl (x)), (x.FStar_Syntax_Syntax.sort), (t1))))::[]))), (_160_513))) -in FStar_Syntax_Syntax.Tm_let (_160_514)) -in (FStar_All.pipe_left mk _160_515)))) +in (let _160_542 = (let _160_541 = (let _160_540 = (let _160_539 = (let _160_538 = (FStar_Syntax_Syntax.mk_binder x) +in (_160_538)::[]) +in (FStar_Syntax_Subst.close _160_539 body)) +in ((((false), (((mk_lb ((FStar_Util.Inl (x)), (x.FStar_Syntax_Syntax.sort), (t1))))::[]))), (_160_540))) +in FStar_Syntax_Syntax.Tm_let (_160_541)) +in (FStar_All.pipe_left mk _160_542)))) end) in if is_mutable then begin (FStar_All.pipe_left mk (FStar_Syntax_Syntax.Tm_meta (((tm), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Mutable_alloc)))))) @@ -1926,18 +1947,18 @@ end ( let x = (FStar_Syntax_Syntax.new_bv (Some (t3.FStar_Parser_AST.range)) FStar_Syntax_Syntax.tun) -in (let _160_526 = (let _160_525 = (let _160_524 = (desugar_term env t1) -in (let _160_523 = (let _160_522 = (let _160_517 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t2.FStar_Parser_AST.range) -in (let _160_516 = (desugar_term env t2) -in ((_160_517), (None), (_160_516)))) -in (let _160_521 = (let _160_520 = (let _160_519 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_wild (x)) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t3.FStar_Parser_AST.range) -in (let _160_518 = (desugar_term env t3) -in ((_160_519), (None), (_160_518)))) -in (_160_520)::[]) -in (_160_522)::_160_521)) -in ((_160_524), (_160_523)))) -in FStar_Syntax_Syntax.Tm_match (_160_525)) -in (mk _160_526))) +in (let _160_553 = (let _160_552 = (let _160_551 = (desugar_term env t1) +in (let _160_550 = (let _160_549 = (let _160_544 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t2.FStar_Parser_AST.range) +in (let _160_543 = (desugar_term env t2) +in ((_160_544), (None), (_160_543)))) +in (let _160_548 = (let _160_547 = (let _160_546 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_wild (x)) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t3.FStar_Parser_AST.range) +in (let _160_545 = (desugar_term env t3) +in ((_160_546), (None), (_160_545)))) +in (_160_547)::[]) +in (_160_549)::_160_548)) +in ((_160_551), (_160_550)))) +in FStar_Syntax_Syntax.Tm_match (_160_552)) +in (mk _160_553))) end | FStar_Parser_AST.TryWith (e, branches) -> begin ( @@ -1960,12 +1981,12 @@ end | FStar_Parser_AST.Match (e, branches) -> begin ( -let desugar_branch = (fun _65_1434 -> (match (_65_1434) with +let desugar_branch = (fun _65_1443 -> (match (_65_1443) with | (pat, wopt, b) -> begin ( -let _65_1437 = (desugar_match_pat env pat) -in (match (_65_1437) with +let _65_1446 = (desugar_match_pat env pat) +in (match (_65_1446) with | (env, pat) -> begin ( @@ -1974,8 +1995,8 @@ let wopt = (match (wopt) with None end | Some (e) -> begin -(let _160_529 = (desugar_term env e) -in Some (_160_529)) +(let _160_556 = (desugar_term env e) +in Some (_160_556)) end) in ( @@ -1983,11 +2004,11 @@ let b = (desugar_term env b) in (FStar_Syntax_Util.branch ((pat), (wopt), (b))))) end)) end)) -in (let _160_533 = (let _160_532 = (let _160_531 = (desugar_term env e) -in (let _160_530 = (FStar_List.map desugar_branch branches) -in ((_160_531), (_160_530)))) -in FStar_Syntax_Syntax.Tm_match (_160_532)) -in (FStar_All.pipe_left mk _160_533))) +in (let _160_560 = (let _160_559 = (let _160_558 = (desugar_term env e) +in (let _160_557 = (FStar_List.map desugar_branch branches) +in ((_160_558), (_160_557)))) +in FStar_Syntax_Syntax.Tm_match (_160_559)) +in (FStar_All.pipe_left mk _160_560))) end | FStar_Parser_AST.Ascribed (e, t) -> begin ( @@ -2003,72 +2024,68 @@ FStar_Util.Inl ((FStar_Syntax_Util.comp_result c)) end else begin FStar_Util.Inr (c) end -in (let _160_536 = (let _160_535 = (let _160_534 = (desugar_term env e) -in ((_160_534), (annot), (None))) -in FStar_Syntax_Syntax.Tm_ascribed (_160_535)) -in (FStar_All.pipe_left mk _160_536))))) +in (let _160_563 = (let _160_562 = (let _160_561 = (desugar_term env e) +in ((_160_561), (annot), (None))) +in FStar_Syntax_Syntax.Tm_ascribed (_160_562)) +in (FStar_All.pipe_left mk _160_563))))) end -| FStar_Parser_AST.Record (_65_1451, []) -> begin +| FStar_Parser_AST.Record (_65_1460, []) -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected empty record"), (top.FStar_Parser_AST.range))))) end | FStar_Parser_AST.Record (eopt, fields) -> begin ( -let _65_1462 = (FStar_List.hd fields) -in (match (_65_1462) with -| (f, _65_1461) -> begin +let _65_1471 = (FStar_List.hd fields) +in (match (_65_1471) with +| (f, _65_1470) -> begin ( -let qfn = (fun g -> (FStar_Ident.lid_of_ids (FStar_List.append f.FStar_Ident.ns ((g)::[])))) -in ( - -let _65_1468 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_record_by_field_name env) f) -in (match (_65_1468) with -| (record, _65_1467) -> begin +let _65_1475 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_record_by_field_name env) f) +in (match (_65_1475) with +| (record, _65_1474) -> begin ( -let get_field = (fun xopt f -> ( - -let fn = f.FStar_Ident.ident +let fields' = (FStar_All.pipe_right fields (FStar_List.map (fun _65_1478 -> (match (_65_1478) with +| (f, e) -> begin +(let _160_565 = (FStar_Syntax_Util.mk_field_projector_name_from_ident record.FStar_Parser_Env.constrname f.FStar_Ident.ident) +in ((_160_565), (e))) +end)))) in ( -let found = (FStar_All.pipe_right fields (FStar_Util.find_opt (fun _65_1476 -> (match (_65_1476) with -| (g, _65_1475) -> begin -( +let get_field = (fun xopt f -> ( -let gn = g.FStar_Ident.ident -in (fn.FStar_Ident.idText = gn.FStar_Ident.idText)) +let found = (FStar_All.pipe_right fields' (FStar_Util.find_opt (fun _65_1486 -> (match (_65_1486) with +| (g, _65_1485) -> begin +(FStar_Ident.lid_equals f g) end)))) in (match (found) with -| Some (_65_1480, e) -> begin -(let _160_544 = (qfn fn) -in ((_160_544), (e))) +| Some (_65_1489, e) -> begin +((f), (e)) end | None -> begin (match (xopt) with | None -> begin -(let _160_547 = (let _160_546 = (let _160_545 = (FStar_Util.format1 "Field %s is missing" (FStar_Ident.text_of_lid f)) -in ((_160_545), (top.FStar_Parser_AST.range))) -in FStar_Syntax_Syntax.Error (_160_546)) -in (Prims.raise _160_547)) +(let _160_573 = (let _160_572 = (let _160_571 = (FStar_Util.format1 "Field %s is missing" (FStar_Ident.text_of_lid f)) +in ((_160_571), (top.FStar_Parser_AST.range))) +in FStar_Syntax_Syntax.Error (_160_572)) +in (Prims.raise _160_573)) end | Some (x) -> begin -(let _160_548 = (qfn fn) -in ((_160_548), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Project (((x), (f)))) x.FStar_Parser_AST.range x.FStar_Parser_AST.level)))) +((f), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Project (((x), (f)))) x.FStar_Parser_AST.range x.FStar_Parser_AST.level))) end) -end)))) +end))) in ( let recterm = (match (eopt) with | None -> begin -(let _160_553 = (let _160_552 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_1492 -> (match (_65_1492) with -| (f, _65_1491) -> begin -(let _160_551 = (let _160_550 = (get_field None f) -in (FStar_All.pipe_left Prims.snd _160_550)) -in ((_160_551), (FStar_Parser_AST.Nothing))) +(let _160_578 = (let _160_577 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_1501 -> (match (_65_1501) with +| (f, _65_1500) -> begin +(let _160_576 = (let _160_575 = (get_field None f) +in (FStar_All.pipe_left Prims.snd _160_575)) +in ((_160_576), (FStar_Parser_AST.Nothing))) end)))) -in ((record.FStar_Parser_Env.constrname), (_160_552))) -in FStar_Parser_AST.Construct (_160_553)) +in ((record.FStar_Parser_Env.constrname), (_160_577))) +in FStar_Parser_AST.Construct (_160_578)) end | Some (e) -> begin ( @@ -2076,17 +2093,17 @@ end let x = (FStar_Ident.gen e.FStar_Parser_AST.range) in ( -let xterm = (let _160_555 = (let _160_554 = (FStar_Ident.lid_of_ids ((x)::[])) -in FStar_Parser_AST.Var (_160_554)) -in (FStar_Parser_AST.mk_term _160_555 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) +let xterm = (let _160_580 = (let _160_579 = (FStar_Ident.lid_of_ids ((x)::[])) +in FStar_Parser_AST.Var (_160_579)) +in (FStar_Parser_AST.mk_term _160_580 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) in ( -let record = (let _160_558 = (let _160_557 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_1500 -> (match (_65_1500) with -| (f, _65_1499) -> begin +let record = (let _160_583 = (let _160_582 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map (fun _65_1509 -> (match (_65_1509) with +| (f, _65_1508) -> begin (get_field (Some (xterm)) f) end)))) -in ((None), (_160_557))) -in FStar_Parser_AST.Record (_160_558)) +in ((None), (_160_582))) +in FStar_Parser_AST.Record (_160_583)) in FStar_Parser_AST.Let (((FStar_Parser_AST.NoLetQualifier), (((((FStar_Parser_AST.mk_pattern (FStar_Parser_AST.PatVar (((x), (None)))) x.FStar_Ident.idRange)), (e)))::[]), ((FStar_Parser_AST.mk_term record top.FStar_Parser_AST.range top.FStar_Parser_AST.level))))))) end) in ( @@ -2096,43 +2113,37 @@ in ( let e = (desugar_term env recterm) in (match (e.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_meta ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (fv); FStar_Syntax_Syntax.tk = _65_1516; FStar_Syntax_Syntax.pos = _65_1514; FStar_Syntax_Syntax.vars = _65_1512}, args); FStar_Syntax_Syntax.tk = _65_1510; FStar_Syntax_Syntax.pos = _65_1508; FStar_Syntax_Syntax.vars = _65_1506}, FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app)) -> begin +| FStar_Syntax_Syntax.Tm_meta ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (fv); FStar_Syntax_Syntax.tk = _65_1525; FStar_Syntax_Syntax.pos = _65_1523; FStar_Syntax_Syntax.vars = _65_1521}, args); FStar_Syntax_Syntax.tk = _65_1519; FStar_Syntax_Syntax.pos = _65_1517; FStar_Syntax_Syntax.vars = _65_1515}, FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app)) -> begin ( -let e = (let _160_565 = (let _160_564 = (let _160_563 = (let _160_562 = (let _160_561 = (let _160_560 = (let _160_559 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map Prims.fst)) -in ((record.FStar_Parser_Env.typename), (_160_559))) -in FStar_Syntax_Syntax.Record_ctor (_160_560)) -in Some (_160_561)) -in (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v e.FStar_Syntax_Syntax.pos) FStar_Syntax_Syntax.Delta_constant _160_562)) -in ((_160_563), (args))) -in FStar_Syntax_Syntax.Tm_app (_160_564)) -in (FStar_All.pipe_left mk _160_565)) +let e = (let _160_590 = (let _160_589 = (let _160_588 = (let _160_587 = (let _160_586 = (let _160_585 = (let _160_584 = (FStar_All.pipe_right record.FStar_Parser_Env.fields (FStar_List.map Prims.fst)) +in ((record.FStar_Parser_Env.typename), (_160_584))) +in FStar_Syntax_Syntax.Record_ctor (_160_585)) +in Some (_160_586)) +in (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v e.FStar_Syntax_Syntax.pos) FStar_Syntax_Syntax.Delta_constant _160_587)) +in ((_160_588), (args))) +in FStar_Syntax_Syntax.Tm_app (_160_589)) +in (FStar_All.pipe_left mk _160_590)) in (FStar_All.pipe_left mk (FStar_Syntax_Syntax.Tm_meta (((e), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app))))))) end -| _65_1530 -> begin +| _65_1539 -> begin e -end))))) -end))) +end)))))) +end)) end)) end | FStar_Parser_AST.Project (e, f) -> begin ( -let _65_1537 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_projector_by_field_name env) f) -in (match (_65_1537) with +let _65_1546 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_projector_by_field_name env) f) +in (match (_65_1546) with | (fieldname, is_rec) -> begin ( let e = (desugar_term env e) in ( -let fn = ( - -let _65_1542 = (FStar_Util.prefix fieldname.FStar_Ident.ns) -in (match (_65_1542) with -| (ns, _65_1541) -> begin -(FStar_Ident.lid_of_ids (FStar_List.append ns ((f.FStar_Ident.ident)::[]))) -end)) +let fn = fieldname in ( let qual = if is_rec then begin @@ -2140,76 +2151,76 @@ Some (FStar_Syntax_Syntax.Record_projector (fn)) end else begin None end -in (let _160_570 = (let _160_569 = (let _160_568 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range fieldname (FStar_Ident.range_of_lid f)) FStar_Syntax_Syntax.Delta_equational qual) -in (let _160_567 = (let _160_566 = (FStar_Syntax_Syntax.as_arg e) -in (_160_566)::[]) -in ((_160_568), (_160_567)))) -in FStar_Syntax_Syntax.Tm_app (_160_569)) -in (FStar_All.pipe_left mk _160_570))))) +in (let _160_595 = (let _160_594 = (let _160_593 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range fieldname (FStar_Ident.range_of_lid f)) FStar_Syntax_Syntax.Delta_equational qual) +in (let _160_592 = (let _160_591 = (FStar_Syntax_Syntax.as_arg e) +in (_160_591)::[]) +in ((_160_593), (_160_592)))) +in FStar_Syntax_Syntax.Tm_app (_160_594)) +in (FStar_All.pipe_left mk _160_595))))) end)) end | (FStar_Parser_AST.NamedTyp (_, e)) | (FStar_Parser_AST.Paren (e)) -> begin (desugar_term env e) end -| _65_1552 when (top.FStar_Parser_AST.level = FStar_Parser_AST.Formula) -> begin +| _65_1557 when (top.FStar_Parser_AST.level = FStar_Parser_AST.Formula) -> begin (desugar_formula env top) end -| _65_1554 -> begin +| _65_1559 -> begin (FStar_Parser_AST.error "Unexpected term" top top.FStar_Parser_AST.range) end -| FStar_Parser_AST.Let (_65_1556, _65_1558, _65_1560) -> begin +| FStar_Parser_AST.Let (_65_1561, _65_1563, _65_1565) -> begin (FStar_All.failwith "Not implemented yet") end -| FStar_Parser_AST.QForall (_65_1564, _65_1566, _65_1568) -> begin +| FStar_Parser_AST.QForall (_65_1569, _65_1571, _65_1573) -> begin (FStar_All.failwith "Not implemented yet") end -| FStar_Parser_AST.QExists (_65_1572, _65_1574, _65_1576) -> begin +| FStar_Parser_AST.QExists (_65_1577, _65_1579, _65_1581) -> begin (FStar_All.failwith "Not implemented yet") end)))) -and desugar_args : FStar_Parser_Env.env -> (FStar_Parser_AST.term * FStar_Parser_AST.imp) Prims.list -> (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list = (fun env args -> (FStar_All.pipe_right args (FStar_List.map (fun _65_1583 -> (match (_65_1583) with +and desugar_args : FStar_Parser_Env.env -> (FStar_Parser_AST.term * FStar_Parser_AST.imp) Prims.list -> (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list = (fun env args -> (FStar_All.pipe_right args (FStar_List.map (fun _65_1588 -> (match (_65_1588) with | (a, imp) -> begin -(let _160_574 = (desugar_term env a) -in (arg_withimp_e imp _160_574)) +(let _160_599 = (desugar_term env a) +in (arg_withimp_e imp _160_599)) end))))) and desugar_comp : FStar_Range.range -> Prims.bool -> FStar_Parser_Env.env -> FStar_Parser_AST.term -> (FStar_Syntax_Syntax.comp', Prims.unit) FStar_Syntax_Syntax.syntax = (fun r default_ok env t -> ( let fail = (fun msg -> (Prims.raise (FStar_Syntax_Syntax.Error (((msg), (r)))))) in ( -let is_requires = (fun _65_1595 -> (match (_65_1595) with -| (t, _65_1594) -> begin -(match ((let _160_582 = (unparen t) -in _160_582.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.Requires (_65_1597) -> begin +let is_requires = (fun _65_1600 -> (match (_65_1600) with +| (t, _65_1599) -> begin +(match ((let _160_607 = (unparen t) +in _160_607.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.Requires (_65_1602) -> begin true end -| _65_1600 -> begin +| _65_1605 -> begin false end) end)) in ( -let is_ensures = (fun _65_1605 -> (match (_65_1605) with -| (t, _65_1604) -> begin -(match ((let _160_585 = (unparen t) -in _160_585.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.Ensures (_65_1607) -> begin +let is_ensures = (fun _65_1610 -> (match (_65_1610) with +| (t, _65_1609) -> begin +(match ((let _160_610 = (unparen t) +in _160_610.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.Ensures (_65_1612) -> begin true end -| _65_1610 -> begin +| _65_1615 -> begin false end) end)) in ( -let is_app = (fun head _65_1616 -> (match (_65_1616) with -| (t, _65_1615) -> begin -(match ((let _160_590 = (unparen t) -in _160_590.FStar_Parser_AST.tm)) with -| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (d); FStar_Parser_AST.range = _65_1620; FStar_Parser_AST.level = _65_1618}, _65_1625, _65_1627) -> begin +let is_app = (fun head _65_1621 -> (match (_65_1621) with +| (t, _65_1620) -> begin +(match ((let _160_615 = (unparen t) +in _160_615.FStar_Parser_AST.tm)) with +| FStar_Parser_AST.App ({FStar_Parser_AST.tm = FStar_Parser_AST.Var (d); FStar_Parser_AST.range = _65_1625; FStar_Parser_AST.level = _65_1623}, _65_1630, _65_1632) -> begin (d.FStar_Ident.ident.FStar_Ident.idText = head) end -| _65_1631 -> begin +| _65_1636 -> begin false end) end)) @@ -2220,8 +2231,8 @@ in ( let pre_process_comp_typ = (fun t -> ( -let _65_1637 = (head_and_args t) -in (match (_65_1637) with +let _65_1642 = (head_and_args t) +in (match (_65_1642) with | (head, args) -> begin (match (head.FStar_Parser_AST.tm) with | FStar_Parser_AST.Name (lemma) when (lemma.FStar_Ident.ident.FStar_Ident.idText = "Lemma") -> begin @@ -2261,49 +2272,49 @@ let head = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_effect_nam in ((head), (args))))))) end | FStar_Parser_AST.Name (l) when (FStar_Parser_Env.is_effect_name env l) -> begin -(let _160_594 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_effect_name env) l) -in ((_160_594), (args))) +(let _160_619 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_effect_name env) l) +in ((_160_619), (args))) end -| FStar_Parser_AST.Name (l) when ((let _160_595 = (FStar_Parser_Env.current_module env) -in (FStar_Ident.lid_equals _160_595 FStar_Syntax_Const.prims_lid)) && (l.FStar_Ident.ident.FStar_Ident.idText = "Tot")) -> begin +| FStar_Parser_AST.Name (l) when ((let _160_620 = (FStar_Parser_Env.current_module env) +in (FStar_Ident.lid_equals _160_620 FStar_Syntax_Const.prims_lid)) && (l.FStar_Ident.ident.FStar_Ident.idText = "Tot")) -> begin (((FStar_Ident.set_lid_range FStar_Syntax_Const.effect_Tot_lid head.FStar_Parser_AST.range)), (args)) end -| FStar_Parser_AST.Name (l) when ((let _160_596 = (FStar_Parser_Env.current_module env) -in (FStar_Ident.lid_equals _160_596 FStar_Syntax_Const.prims_lid)) && (l.FStar_Ident.ident.FStar_Ident.idText = "GTot")) -> begin +| FStar_Parser_AST.Name (l) when ((let _160_621 = (FStar_Parser_Env.current_module env) +in (FStar_Ident.lid_equals _160_621 FStar_Syntax_Const.prims_lid)) && (l.FStar_Ident.ident.FStar_Ident.idText = "GTot")) -> begin (((FStar_Ident.set_lid_range FStar_Syntax_Const.effect_GTot_lid head.FStar_Parser_AST.range)), (args)) end | FStar_Parser_AST.Name (l) when ((((l.FStar_Ident.ident.FStar_Ident.idText = "Type") || (l.FStar_Ident.ident.FStar_Ident.idText = "Type0")) || (l.FStar_Ident.ident.FStar_Ident.idText = "Effect")) && default_ok) -> begin (((FStar_Ident.set_lid_range FStar_Syntax_Const.effect_Tot_lid head.FStar_Parser_AST.range)), ((((t), (FStar_Parser_AST.Nothing)))::[])) end -| _65_1668 when default_ok -> begin +| _65_1673 when default_ok -> begin (((FStar_Ident.set_lid_range env.FStar_Parser_Env.default_result_effect head.FStar_Parser_AST.range)), ((((t), (FStar_Parser_AST.Nothing)))::[])) end -| _65_1670 -> begin -(let _160_598 = (let _160_597 = (FStar_Parser_AST.term_to_string t) -in (FStar_Util.format1 "%s is not an effect" _160_597)) -in (fail _160_598)) +| _65_1675 -> begin +(let _160_623 = (let _160_622 = (FStar_Parser_AST.term_to_string t) +in (FStar_Util.format1 "%s is not an effect" _160_622)) +in (fail _160_623)) end) end))) in ( -let _65_1673 = (pre_process_comp_typ t) -in (match (_65_1673) with +let _65_1678 = (pre_process_comp_typ t) +in (match (_65_1678) with | (eff, args) -> begin ( -let _65_1674 = if ((FStar_List.length args) = (Prims.parse_int "0")) then begin -(let _160_600 = (let _160_599 = (FStar_Syntax_Print.lid_to_string eff) -in (FStar_Util.format1 "Not enough args to effect %s" _160_599)) -in (fail _160_600)) +let _65_1679 = if ((FStar_List.length args) = (Prims.parse_int "0")) then begin +(let _160_625 = (let _160_624 = (FStar_Syntax_Print.lid_to_string eff) +in (FStar_Util.format1 "Not enough args to effect %s" _160_624)) +in (fail _160_625)) end else begin () end in ( -let _65_1678 = (let _160_602 = (FStar_List.hd args) -in (let _160_601 = (FStar_List.tl args) -in ((_160_602), (_160_601)))) -in (match (_65_1678) with +let _65_1683 = (let _160_627 = (FStar_List.hd args) +in (let _160_626 = (FStar_List.tl args) +in ((_160_627), (_160_626)))) +in (match (_65_1683) with | (result_arg, rest) -> begin ( @@ -2313,27 +2324,27 @@ in ( let rest = (desugar_args env rest) in ( -let _65_1703 = (FStar_All.pipe_right rest (FStar_List.partition (fun _65_1684 -> (match (_65_1684) with -| (t, _65_1683) -> begin +let _65_1708 = (FStar_All.pipe_right rest (FStar_List.partition (fun _65_1689 -> (match (_65_1689) with +| (t, _65_1688) -> begin (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (fv); FStar_Syntax_Syntax.tk = _65_1690; FStar_Syntax_Syntax.pos = _65_1688; FStar_Syntax_Syntax.vars = _65_1686}, (_65_1695)::[]) -> begin +| FStar_Syntax_Syntax.Tm_app ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (fv); FStar_Syntax_Syntax.tk = _65_1695; FStar_Syntax_Syntax.pos = _65_1693; FStar_Syntax_Syntax.vars = _65_1691}, (_65_1700)::[]) -> begin (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.decreases_lid) end -| _65_1700 -> begin +| _65_1705 -> begin false end) end)))) -in (match (_65_1703) with +in (match (_65_1708) with | (dec, rest) -> begin ( -let decreases_clause = (FStar_All.pipe_right dec (FStar_List.map (fun _65_1707 -> (match (_65_1707) with -| (t, _65_1706) -> begin +let decreases_clause = (FStar_All.pipe_right dec (FStar_List.map (fun _65_1712 -> (match (_65_1712) with +| (t, _65_1711) -> begin (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_app (_65_1709, ((arg, _65_1712))::[]) -> begin +| FStar_Syntax_Syntax.Tm_app (_65_1714, ((arg, _65_1717))::[]) -> begin FStar_Syntax_Syntax.DECREASES (arg) end -| _65_1718 -> begin +| _65_1723 -> begin (FStar_All.failwith "impos") end) end)))) @@ -2379,20 +2390,20 @@ let pat = (match (pat.FStar_Syntax_Syntax.n) with let nil = (FStar_Syntax_Syntax.mk_Tm_uinst pat ((FStar_Syntax_Syntax.U_succ (FStar_Syntax_Syntax.U_zero))::[])) in ( -let pattern = (let _160_605 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Syntax_Const.pattern_lid pat.FStar_Syntax_Syntax.pos) FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.mk_Tm_uinst _160_605 ((FStar_Syntax_Syntax.U_zero)::[]))) +let pattern = (let _160_630 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Syntax_Const.pattern_lid pat.FStar_Syntax_Syntax.pos) FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.mk_Tm_uinst _160_630 ((FStar_Syntax_Syntax.U_zero)::[]))) in (FStar_Syntax_Syntax.mk_Tm_app nil ((((pattern), (Some (FStar_Syntax_Syntax.imp_tag))))::[]) None pat.FStar_Syntax_Syntax.pos))) end -| _65_1733 -> begin +| _65_1738 -> begin pat end) -in (let _160_609 = (let _160_608 = (let _160_607 = (let _160_606 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (((pat), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Meta_smt_pat))))) None pat.FStar_Syntax_Syntax.pos) -in ((_160_606), (aq))) -in (_160_607)::[]) -in (ens)::_160_608) -in (req)::_160_609)) +in (let _160_634 = (let _160_633 = (let _160_632 = (let _160_631 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (((pat), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Meta_smt_pat))))) None pat.FStar_Syntax_Syntax.pos) +in ((_160_631), (aq))) +in (_160_632)::[]) +in (ens)::_160_633) +in (req)::_160_634)) end -| _65_1736 -> begin +| _65_1741 -> begin rest end) end else begin @@ -2422,7 +2433,7 @@ end | "~" -> begin Some (FStar_Syntax_Const.not_lid) end -| _65_1748 -> begin +| _65_1753 -> begin None end)) in ( @@ -2435,33 +2446,33 @@ in ( let setpos = (fun t -> ( -let _65_1755 = t -in {FStar_Syntax_Syntax.n = _65_1755.FStar_Syntax_Syntax.n; FStar_Syntax_Syntax.tk = _65_1755.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = f.FStar_Parser_AST.range; FStar_Syntax_Syntax.vars = _65_1755.FStar_Syntax_Syntax.vars})) +let _65_1760 = t +in {FStar_Syntax_Syntax.n = _65_1760.FStar_Syntax_Syntax.n; FStar_Syntax_Syntax.tk = _65_1760.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = f.FStar_Parser_AST.range; FStar_Syntax_Syntax.vars = _65_1760.FStar_Syntax_Syntax.vars})) in ( let desugar_quant = (fun q b pats body -> ( let tk = (desugar_binder env ( -let _65_1762 = b -in {FStar_Parser_AST.b = _65_1762.FStar_Parser_AST.b; FStar_Parser_AST.brange = _65_1762.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _65_1762.FStar_Parser_AST.aqual})) +let _65_1767 = b +in {FStar_Parser_AST.b = _65_1767.FStar_Parser_AST.b; FStar_Parser_AST.brange = _65_1767.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _65_1767.FStar_Parser_AST.aqual})) in ( -let desugar_pats = (fun env pats -> (FStar_List.map (fun es -> (FStar_All.pipe_right es (FStar_List.map (fun e -> (let _160_644 = (desugar_term env e) -in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _160_644)))))) pats)) +let desugar_pats = (fun env pats -> (FStar_List.map (fun es -> (FStar_All.pipe_right es (FStar_List.map (fun e -> (let _160_669 = (desugar_term env e) +in (FStar_All.pipe_left (arg_withimp_t FStar_Parser_AST.Nothing) _160_669)))))) pats)) in (match (tk) with | (Some (a), k) -> begin ( -let _65_1776 = (FStar_Parser_Env.push_bv env a) -in (match (_65_1776) with +let _65_1781 = (FStar_Parser_Env.push_bv env a) +in (match (_65_1781) with | (env, a) -> begin ( let a = ( -let _65_1777 = a -in {FStar_Syntax_Syntax.ppname = _65_1777.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1777.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k}) +let _65_1782 = a +in {FStar_Syntax_Syntax.ppname = _65_1782.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1782.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k}) in ( let pats = (desugar_pats env pats) @@ -2474,24 +2485,24 @@ let body = (match (pats) with | [] -> begin body end -| _65_1784 -> begin +| _65_1789 -> begin (mk (FStar_Syntax_Syntax.Tm_meta (((body), (FStar_Syntax_Syntax.Meta_pattern (pats)))))) end) in ( -let body = (let _160_647 = (let _160_646 = (let _160_645 = (FStar_Syntax_Syntax.mk_binder a) -in (_160_645)::[]) -in (no_annot_abs _160_646 body)) -in (FStar_All.pipe_left setpos _160_647)) -in (let _160_652 = (let _160_651 = (let _160_650 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange) (FStar_Syntax_Syntax.Delta_defined_at_level ((Prims.parse_int "1"))) None) -in (let _160_649 = (let _160_648 = (FStar_Syntax_Syntax.as_arg body) -in (_160_648)::[]) -in ((_160_650), (_160_649)))) -in FStar_Syntax_Syntax.Tm_app (_160_651)) -in (FStar_All.pipe_left mk _160_652))))))) +let body = (let _160_672 = (let _160_671 = (let _160_670 = (FStar_Syntax_Syntax.mk_binder a) +in (_160_670)::[]) +in (no_annot_abs _160_671 body)) +in (FStar_All.pipe_left setpos _160_672)) +in (let _160_677 = (let _160_676 = (let _160_675 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange) (FStar_Syntax_Syntax.Delta_defined_at_level ((Prims.parse_int "1"))) None) +in (let _160_674 = (let _160_673 = (FStar_Syntax_Syntax.as_arg body) +in (_160_673)::[]) +in ((_160_675), (_160_674)))) +in FStar_Syntax_Syntax.Tm_app (_160_676)) +in (FStar_All.pipe_left mk _160_677))))))) end)) end -| _65_1788 -> begin +| _65_1793 -> begin (FStar_All.failwith "impossible") end)))) in ( @@ -2503,17 +2514,17 @@ let push_quant = (fun q binders pats body -> (match (binders) with let rest = (b')::_rest in ( -let body = (let _160_667 = (q ((rest), (pats), (body))) -in (let _160_666 = (FStar_Range.union_ranges b'.FStar_Parser_AST.brange body.FStar_Parser_AST.range) -in (FStar_Parser_AST.mk_term _160_667 _160_666 FStar_Parser_AST.Formula))) -in (let _160_668 = (q (((b)::[]), ([]), (body))) -in (FStar_Parser_AST.mk_term _160_668 f.FStar_Parser_AST.range FStar_Parser_AST.Formula)))) +let body = (let _160_692 = (q ((rest), (pats), (body))) +in (let _160_691 = (FStar_Range.union_ranges b'.FStar_Parser_AST.brange body.FStar_Parser_AST.range) +in (FStar_Parser_AST.mk_term _160_692 _160_691 FStar_Parser_AST.Formula))) +in (let _160_693 = (q (((b)::[]), ([]), (body))) +in (FStar_Parser_AST.mk_term _160_693 f.FStar_Parser_AST.range FStar_Parser_AST.Formula)))) end -| _65_1802 -> begin +| _65_1807 -> begin (FStar_All.failwith "impossible") end)) -in (match ((let _160_669 = (unparen f) -in _160_669.FStar_Parser_AST.tm)) with +in (match ((let _160_694 = (unparen f) +in _160_694.FStar_Parser_AST.tm)) with | FStar_Parser_AST.Labeled (f, l, p) -> begin ( @@ -2527,15 +2538,15 @@ end ( let binders = (_1)::(_2)::_3 -in (let _160_671 = (push_quant (fun x -> FStar_Parser_AST.QForall (x)) binders pats body) -in (desugar_formula env _160_671))) +in (let _160_696 = (push_quant (fun x -> FStar_Parser_AST.QForall (x)) binders pats body) +in (desugar_formula env _160_696))) end | FStar_Parser_AST.QExists ((_1)::(_2)::_3, pats, body) -> begin ( let binders = (_1)::(_2)::_3 -in (let _160_673 = (push_quant (fun x -> FStar_Parser_AST.QExists (x)) binders pats body) -in (desugar_formula env _160_673))) +in (let _160_698 = (push_quant (fun x -> FStar_Parser_AST.QExists (x)) binders pats body) +in (desugar_formula env _160_698))) end | FStar_Parser_AST.QForall ((b)::[], pats, body) -> begin (desugar_quant FStar_Syntax_Const.forall_lid b pats body) @@ -2546,55 +2557,55 @@ end | FStar_Parser_AST.Paren (f) -> begin (desugar_formula env f) end -| _65_1860 -> begin +| _65_1865 -> begin (desugar_term env f) end)))))))) and typars_of_binders : FStar_Parser_Env.env -> FStar_Parser_AST.binder Prims.list -> (FStar_Parser_Env.env * (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list) = (fun env bs -> ( -let _65_1884 = (FStar_List.fold_left (fun _65_1865 b -> (match (_65_1865) with +let _65_1889 = (FStar_List.fold_left (fun _65_1870 b -> (match (_65_1870) with | (env, out) -> begin ( let tk = (desugar_binder env ( -let _65_1867 = b -in {FStar_Parser_AST.b = _65_1867.FStar_Parser_AST.b; FStar_Parser_AST.brange = _65_1867.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _65_1867.FStar_Parser_AST.aqual})) +let _65_1872 = b +in {FStar_Parser_AST.b = _65_1872.FStar_Parser_AST.b; FStar_Parser_AST.brange = _65_1872.FStar_Parser_AST.brange; FStar_Parser_AST.blevel = FStar_Parser_AST.Formula; FStar_Parser_AST.aqual = _65_1872.FStar_Parser_AST.aqual})) in (match (tk) with | (Some (a), k) -> begin ( -let _65_1876 = (FStar_Parser_Env.push_bv env a) -in (match (_65_1876) with +let _65_1881 = (FStar_Parser_Env.push_bv env a) +in (match (_65_1881) with | (env, a) -> begin ( let a = ( -let _65_1877 = a -in {FStar_Syntax_Syntax.ppname = _65_1877.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1877.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k}) +let _65_1882 = a +in {FStar_Syntax_Syntax.ppname = _65_1882.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_1882.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k}) in ((env), ((((a), ((trans_aqual b.FStar_Parser_AST.aqual))))::out))) end)) end -| _65_1881 -> begin +| _65_1886 -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected binder"), (b.FStar_Parser_AST.brange))))) end)) end)) ((env), ([])) bs) -in (match (_65_1884) with +in (match (_65_1889) with | (env, tpars) -> begin ((env), ((FStar_List.rev tpars))) end))) and desugar_binder : FStar_Parser_Env.env -> FStar_Parser_AST.binder -> (FStar_Ident.ident Prims.option * FStar_Syntax_Syntax.term) = (fun env b -> (match (b.FStar_Parser_AST.b) with | (FStar_Parser_AST.TAnnotated (x, t)) | (FStar_Parser_AST.Annotated (x, t)) -> begin -(let _160_680 = (desugar_typ env t) -in ((Some (x)), (_160_680))) +(let _160_705 = (desugar_typ env t) +in ((Some (x)), (_160_705))) end | FStar_Parser_AST.TVariable (x) -> begin -(let _160_681 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type (FStar_Syntax_Syntax.U_unknown)) None x.FStar_Ident.idRange) -in ((Some (x)), (_160_681))) +(let _160_706 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type (FStar_Syntax_Syntax.U_unknown)) None x.FStar_Ident.idRange) +in ((Some (x)), (_160_706))) end | FStar_Parser_AST.NoName (t) -> begin -(let _160_682 = (desugar_typ env t) -in ((None), (_160_682))) +(let _160_707 = (desugar_typ env t) +in ((None), (_160_707))) end | FStar_Parser_AST.Variable (x) -> begin ((Some (x)), (FStar_Syntax_Syntax.tun)) @@ -2607,7 +2618,7 @@ let quals = (FStar_All.pipe_right quals (FStar_List.filter (fun _65_11 -> (match | (FStar_Syntax_Syntax.Abstract) | (FStar_Syntax_Syntax.Private) -> begin true end -| _65_1909 -> begin +| _65_1914 -> begin false end)))) in ( @@ -2619,43 +2630,43 @@ end else begin end) in ( -let binders = (let _160_699 = (let _160_698 = (FStar_Syntax_Util.arrow_formals k) -in (Prims.fst _160_698)) -in (FStar_List.append tps _160_699)) +let binders = (let _160_724 = (let _160_723 = (FStar_Syntax_Util.arrow_formals k) +in (Prims.fst _160_723)) +in (FStar_List.append tps _160_724)) in ( let p = (FStar_Ident.range_of_lid t) in ( -let _65_1917 = (FStar_Syntax_Util.args_of_binders binders) -in (match (_65_1917) with +let _65_1922 = (FStar_Syntax_Util.args_of_binders binders) +in (match (_65_1922) with | (binders, args) -> begin ( -let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _65_1921 -> (match (_65_1921) with -| (x, _65_1920) -> begin +let imp_binders = (FStar_All.pipe_right binders (FStar_List.map (fun _65_1926 -> (match (_65_1926) with +| (x, _65_1925) -> begin ((x), (Some (FStar_Syntax_Syntax.imp_tag))) end)))) in ( -let binders = (let _160_705 = (let _160_704 = (let _160_703 = (let _160_702 = (let _160_701 = (FStar_Syntax_Syntax.lid_as_fv t FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_701)) -in (FStar_Syntax_Syntax.mk_Tm_app _160_702 args None p)) -in (FStar_All.pipe_left FStar_Syntax_Syntax.null_binder _160_703)) -in (_160_704)::[]) -in (FStar_List.append imp_binders _160_705)) +let binders = (let _160_730 = (let _160_729 = (let _160_728 = (let _160_727 = (let _160_726 = (FStar_Syntax_Syntax.lid_as_fv t FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_726)) +in (FStar_Syntax_Syntax.mk_Tm_app _160_727 args None p)) +in (FStar_All.pipe_left FStar_Syntax_Syntax.null_binder _160_728)) +in (_160_729)::[]) +in (FStar_List.append imp_binders _160_730)) in ( -let disc_type = (let _160_708 = (let _160_707 = (let _160_706 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.bool_lid FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_706)) -in (FStar_Syntax_Syntax.mk_Total _160_707)) -in (FStar_Syntax_Util.arrow binders _160_708)) +let disc_type = (let _160_733 = (let _160_732 = (let _160_731 = (FStar_Syntax_Syntax.lid_as_fv FStar_Syntax_Const.bool_lid FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_731)) +in (FStar_Syntax_Syntax.mk_Total _160_732)) +in (FStar_Syntax_Util.arrow binders _160_733)) in (FStar_All.pipe_right datas (FStar_List.map (fun d -> ( let disc_name = (FStar_Syntax_Util.mk_discriminator d) -in (let _160_711 = (let _160_710 = (quals ((FStar_Syntax_Syntax.Logic)::(FStar_Syntax_Syntax.Discriminator (d))::[])) -in ((disc_name), ([]), (disc_type), (_160_710), ((FStar_Ident.range_of_lid disc_name)))) -in FStar_Syntax_Syntax.Sig_declare_typ (_160_711))))))))) +in (let _160_736 = (let _160_735 = (quals ((FStar_Syntax_Syntax.Logic)::(FStar_Syntax_Syntax.Discriminator (d))::[])) +in ((disc_name), ([]), (disc_type), (_160_735), ((FStar_Ident.range_of_lid disc_name)))) +in FStar_Syntax_Syntax.Sig_declare_typ (_160_736))))))))) end))))))) @@ -2670,60 +2681,60 @@ in ( let projectee = (fun ptyp -> (FStar_Syntax_Syntax.gen_bv "projectee" (Some (p)) ptyp)) in ( -let tps = (FStar_List.map2 (fun _65_1945 _65_1949 -> (match (((_65_1945), (_65_1949))) with -| ((_65_1943, imp), (x, _65_1948)) -> begin +let tps = (FStar_List.map2 (fun _65_1950 _65_1954 -> (match (((_65_1950), (_65_1954))) with +| ((_65_1948, imp), (x, _65_1953)) -> begin ((x), (imp)) end)) inductive_tps imp_tps) in ( -let _65_2050 = ( +let _65_2055 = ( -let _65_1953 = (FStar_Syntax_Util.head_and_args t) -in (match (_65_1953) with +let _65_1958 = (FStar_Syntax_Util.head_and_args t) +in (match (_65_1958) with | (head, args0) -> begin ( let args = ( let rec arguments = (fun tps args -> (match (((tps), (args))) with -| ([], _65_1959) -> begin +| ([], _65_1964) -> begin args end -| (_65_1962, []) -> begin +| (_65_1967, []) -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Not enough arguments to type"), ((FStar_Ident.range_of_lid lid)))))) end -| (((_65_1967, Some (FStar_Syntax_Syntax.Implicit (_65_1969))))::tps', ((_65_1976, Some (FStar_Syntax_Syntax.Implicit (_65_1978))))::args') -> begin +| (((_65_1972, Some (FStar_Syntax_Syntax.Implicit (_65_1974))))::tps', ((_65_1981, Some (FStar_Syntax_Syntax.Implicit (_65_1983))))::args') -> begin (arguments tps' args') end -| (((_65_1986, Some (FStar_Syntax_Syntax.Implicit (_65_1988))))::tps', ((_65_1996, _65_1998))::_65_1994) -> begin +| (((_65_1991, Some (FStar_Syntax_Syntax.Implicit (_65_1993))))::tps', ((_65_2001, _65_2003))::_65_1999) -> begin (arguments tps' args) end -| (((_65_2005, _65_2007))::_65_2003, ((a, Some (FStar_Syntax_Syntax.Implicit (_65_2014))))::_65_2011) -> begin +| (((_65_2010, _65_2012))::_65_2008, ((a, Some (FStar_Syntax_Syntax.Implicit (_65_2019))))::_65_2016) -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected implicit annotation on argument"), (a.FStar_Syntax_Syntax.pos))))) end -| (((_65_2022, _65_2024))::tps', ((_65_2029, _65_2031))::args') -> begin +| (((_65_2027, _65_2029))::tps', ((_65_2034, _65_2036))::args') -> begin (arguments tps' args') end)) in (arguments inductive_tps args0)) in ( -let indices = (FStar_All.pipe_right args (FStar_List.map (fun _65_2036 -> (let _160_743 = (FStar_Syntax_Syntax.new_bv (Some (p)) FStar_Syntax_Syntax.tun) -in (FStar_All.pipe_right _160_743 FStar_Syntax_Syntax.mk_binder))))) +let indices = (FStar_All.pipe_right args (FStar_List.map (fun _65_2041 -> (let _160_768 = (FStar_Syntax_Syntax.new_bv (Some (p)) FStar_Syntax_Syntax.tun) +in (FStar_All.pipe_right _160_768 FStar_Syntax_Syntax.mk_binder))))) in ( -let arg_typ = (let _160_748 = (let _160_744 = (FStar_Syntax_Syntax.lid_as_fv tc FStar_Syntax_Syntax.Delta_constant None) -in (FStar_Syntax_Syntax.fv_to_tm _160_744)) -in (let _160_747 = (FStar_All.pipe_right (FStar_List.append tps indices) (FStar_List.map (fun _65_2041 -> (match (_65_2041) with +let arg_typ = (let _160_773 = (let _160_769 = (FStar_Syntax_Syntax.lid_as_fv tc FStar_Syntax_Syntax.Delta_constant None) +in (FStar_Syntax_Syntax.fv_to_tm _160_769)) +in (let _160_772 = (FStar_All.pipe_right (FStar_List.append tps indices) (FStar_List.map (fun _65_2046 -> (match (_65_2046) with | (x, imp) -> begin -(let _160_746 = (FStar_Syntax_Syntax.bv_to_name x) -in ((_160_746), (imp))) +(let _160_771 = (FStar_Syntax_Syntax.bv_to_name x) +in ((_160_771), (imp))) end)))) -in (FStar_Syntax_Syntax.mk_Tm_app _160_748 _160_747 None p))) +in (FStar_Syntax_Syntax.mk_Tm_app _160_773 _160_772 None p))) in ( let arg_binder = if (not (refine_domain)) then begin -(let _160_749 = (projectee arg_typ) -in (FStar_Syntax_Syntax.mk_binder _160_749)) +(let _160_774 = (projectee arg_typ) +in (FStar_Syntax_Syntax.mk_binder _160_774)) end else begin ( @@ -2731,33 +2742,33 @@ let disc_name = (FStar_Syntax_Util.mk_discriminator lid) in ( let x = (FStar_Syntax_Syntax.new_bv (Some (p)) arg_typ) -in (let _160_757 = ( - -let _65_2045 = (projectee arg_typ) -in (let _160_756 = (let _160_755 = (let _160_754 = (let _160_753 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range disc_name p) FStar_Syntax_Syntax.Delta_equational None) -in (let _160_752 = (let _160_751 = (let _160_750 = (FStar_Syntax_Syntax.bv_to_name x) -in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_750)) -in (_160_751)::[]) -in (FStar_Syntax_Syntax.mk_Tm_app _160_753 _160_752 None p))) -in (FStar_Syntax_Util.b2t _160_754)) -in (FStar_Syntax_Util.refine x _160_755)) -in {FStar_Syntax_Syntax.ppname = _65_2045.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_2045.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _160_756})) -in (FStar_Syntax_Syntax.mk_binder _160_757)))) +in (let _160_782 = ( + +let _65_2050 = (projectee arg_typ) +in (let _160_781 = (let _160_780 = (let _160_779 = (let _160_778 = (FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range disc_name p) FStar_Syntax_Syntax.Delta_equational None) +in (let _160_777 = (let _160_776 = (let _160_775 = (FStar_Syntax_Syntax.bv_to_name x) +in (FStar_All.pipe_left FStar_Syntax_Syntax.as_arg _160_775)) +in (_160_776)::[]) +in (FStar_Syntax_Syntax.mk_Tm_app _160_778 _160_777 None p))) +in (FStar_Syntax_Util.b2t _160_779)) +in (FStar_Syntax_Util.refine x _160_780)) +in {FStar_Syntax_Syntax.ppname = _65_2050.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_2050.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _160_781})) +in (FStar_Syntax_Syntax.mk_binder _160_782)))) end in ((arg_binder), (indices)))))) end)) -in (match (_65_2050) with +in (match (_65_2055) with | (arg_binder, indices) -> begin ( let arg_exp = (FStar_Syntax_Syntax.bv_to_name (Prims.fst arg_binder)) in ( -let imp_binders = (let _160_759 = (FStar_All.pipe_right indices (FStar_List.map (fun _65_2055 -> (match (_65_2055) with -| (x, _65_2054) -> begin +let imp_binders = (let _160_784 = (FStar_All.pipe_right indices (FStar_List.map (fun _65_2060 -> (match (_65_2060) with +| (x, _65_2059) -> begin ((x), (Some (FStar_Syntax_Syntax.imp_tag))) end)))) -in (FStar_List.append imp_tps _160_759)) +in (FStar_List.append imp_tps _160_784)) in ( let binders = (FStar_List.append imp_binders ((arg_binder)::[])) @@ -2766,18 +2777,18 @@ in ( let arg = (FStar_Syntax_Util.arg_of_non_null_binder arg_binder) in ( -let subst = (FStar_All.pipe_right fields (FStar_List.mapi (fun i _65_2063 -> (match (_65_2063) with -| (a, _65_2062) -> begin +let subst = (FStar_All.pipe_right fields (FStar_List.mapi (fun i _65_2068 -> (match (_65_2068) with +| (a, _65_2067) -> begin ( -let _65_2067 = (FStar_Syntax_Util.mk_field_projector_name lid a i) -in (match (_65_2067) with -| (field_name, _65_2066) -> begin +let _65_2072 = (FStar_Syntax_Util.mk_field_projector_name lid a i) +in (match (_65_2072) with +| (field_name, _65_2071) -> begin ( -let proj = (let _160_763 = (let _160_762 = (FStar_Syntax_Syntax.lid_as_fv field_name FStar_Syntax_Syntax.Delta_equational None) -in (FStar_Syntax_Syntax.fv_to_tm _160_762)) -in (FStar_Syntax_Syntax.mk_Tm_app _160_763 ((arg)::[]) None p)) +let proj = (let _160_788 = (let _160_787 = (FStar_Syntax_Syntax.lid_as_fv field_name FStar_Syntax_Syntax.Delta_equational None) +in (FStar_Syntax_Syntax.fv_to_tm _160_787)) +in (FStar_Syntax_Syntax.mk_Tm_app _160_788 ((arg)::[]) None p)) in FStar_Syntax_Syntax.NT (((a), (proj)))) end)) end)))) @@ -2787,38 +2798,38 @@ let ntps = (FStar_List.length tps) in ( let all_params = (FStar_List.append imp_tps fields) -in (let _160_802 = (FStar_All.pipe_right fields (FStar_List.mapi (fun i _65_2076 -> (match (_65_2076) with -| (x, _65_2075) -> begin +in (let _160_827 = (FStar_All.pipe_right fields (FStar_List.mapi (fun i _65_2081 -> (match (_65_2081) with +| (x, _65_2080) -> begin ( -let _65_2080 = (FStar_Syntax_Util.mk_field_projector_name lid x i) -in (match (_65_2080) with -| (field_name, _65_2079) -> begin +let _65_2085 = (FStar_Syntax_Util.mk_field_projector_name lid x i) +in (match (_65_2085) with +| (field_name, _65_2084) -> begin ( -let t = (let _160_767 = (let _160_766 = (FStar_Syntax_Subst.subst subst x.FStar_Syntax_Syntax.sort) -in (FStar_Syntax_Syntax.mk_Total _160_766)) -in (FStar_Syntax_Util.arrow binders _160_767)) +let t = (let _160_792 = (let _160_791 = (FStar_Syntax_Subst.subst subst x.FStar_Syntax_Syntax.sort) +in (FStar_Syntax_Syntax.mk_Total _160_791)) +in (FStar_Syntax_Util.arrow binders _160_792)) in ( -let only_decl = (((let _160_768 = (FStar_Parser_Env.current_module env) -in (FStar_Ident.lid_equals FStar_Syntax_Const.prims_lid _160_768)) || (fvq <> FStar_Syntax_Syntax.Data_ctor)) || (let _160_770 = (let _160_769 = (FStar_Parser_Env.current_module env) -in _160_769.FStar_Ident.str) -in (FStar_Options.dont_gen_projectors _160_770))) +let only_decl = (((let _160_793 = (FStar_Parser_Env.current_module env) +in (FStar_Ident.lid_equals FStar_Syntax_Const.prims_lid _160_793)) || (fvq <> FStar_Syntax_Syntax.Data_ctor)) || (let _160_795 = (let _160_794 = (FStar_Parser_Env.current_module env) +in _160_794.FStar_Ident.str) +in (FStar_Options.dont_gen_projectors _160_795))) in ( let no_decl = (FStar_Syntax_Syntax.is_type x.FStar_Syntax_Syntax.sort) in ( let quals = (fun q -> if only_decl then begin -(let _160_774 = (FStar_List.filter (fun _65_12 -> (match (_65_12) with +(let _160_799 = (FStar_List.filter (fun _65_12 -> (match (_65_12) with | FStar_Syntax_Syntax.Abstract -> begin false end -| _65_2089 -> begin +| _65_2094 -> begin true end)) q) -in (FStar_Syntax_Syntax.Assumption)::_160_774) +in (FStar_Syntax_Syntax.Assumption)::_160_799) end else begin q end) @@ -2830,7 +2841,7 @@ let iquals = (FStar_All.pipe_right iquals (FStar_List.filter (fun _65_13 -> (mat | (FStar_Syntax_Syntax.Abstract) | (FStar_Syntax_Syntax.Private) -> begin true end -| _65_2094 -> begin +| _65_2099 -> begin false end)))) in (quals ((FStar_Syntax_Syntax.Projector (((lid), (x.FStar_Syntax_Syntax.ppname))))::iquals))) @@ -2845,44 +2856,44 @@ end else begin let projection = (FStar_Syntax_Syntax.gen_bv x.FStar_Syntax_Syntax.ppname.FStar_Ident.idText None FStar_Syntax_Syntax.tun) in ( -let arg_pats = (FStar_All.pipe_right all_params (FStar_List.mapi (fun j _65_2102 -> (match (_65_2102) with +let arg_pats = (FStar_All.pipe_right all_params (FStar_List.mapi (fun j _65_2107 -> (match (_65_2107) with | (x, imp) -> begin ( let b = (FStar_Syntax_Syntax.is_implicit imp) in if ((i + ntps) = j) then begin -(let _160_778 = (pos (FStar_Syntax_Syntax.Pat_var (projection))) -in ((_160_778), (b))) +(let _160_803 = (pos (FStar_Syntax_Syntax.Pat_var (projection))) +in ((_160_803), (b))) end else begin if (b && (j < ntps)) then begin -(let _160_782 = (let _160_781 = (let _160_780 = (let _160_779 = (FStar_Syntax_Syntax.gen_bv x.FStar_Syntax_Syntax.ppname.FStar_Ident.idText None FStar_Syntax_Syntax.tun) -in ((_160_779), (FStar_Syntax_Syntax.tun))) -in FStar_Syntax_Syntax.Pat_dot_term (_160_780)) -in (pos _160_781)) -in ((_160_782), (b))) +(let _160_807 = (let _160_806 = (let _160_805 = (let _160_804 = (FStar_Syntax_Syntax.gen_bv x.FStar_Syntax_Syntax.ppname.FStar_Ident.idText None FStar_Syntax_Syntax.tun) +in ((_160_804), (FStar_Syntax_Syntax.tun))) +in FStar_Syntax_Syntax.Pat_dot_term (_160_805)) +in (pos _160_806)) +in ((_160_807), (b))) end else begin -(let _160_785 = (let _160_784 = (let _160_783 = (FStar_Syntax_Syntax.gen_bv x.FStar_Syntax_Syntax.ppname.FStar_Ident.idText None FStar_Syntax_Syntax.tun) -in FStar_Syntax_Syntax.Pat_wild (_160_783)) -in (pos _160_784)) -in ((_160_785), (b))) +(let _160_810 = (let _160_809 = (let _160_808 = (FStar_Syntax_Syntax.gen_bv x.FStar_Syntax_Syntax.ppname.FStar_Ident.idText None FStar_Syntax_Syntax.tun) +in FStar_Syntax_Syntax.Pat_wild (_160_808)) +in (pos _160_809)) +in ((_160_810), (b))) end end) end)))) in ( -let pat = (let _160_790 = (let _160_788 = (let _160_787 = (let _160_786 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (Some (fvq))) -in ((_160_786), (arg_pats))) -in FStar_Syntax_Syntax.Pat_cons (_160_787)) -in (FStar_All.pipe_right _160_788 pos)) -in (let _160_789 = (FStar_Syntax_Syntax.bv_to_name projection) -in ((_160_790), (None), (_160_789)))) +let pat = (let _160_815 = (let _160_813 = (let _160_812 = (let _160_811 = (FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (Some (fvq))) +in ((_160_811), (arg_pats))) +in FStar_Syntax_Syntax.Pat_cons (_160_812)) +in (FStar_All.pipe_right _160_813 pos)) +in (let _160_814 = (FStar_Syntax_Syntax.bv_to_name projection) +in ((_160_815), (None), (_160_814)))) in ( -let body = (let _160_794 = (let _160_793 = (let _160_792 = (let _160_791 = (FStar_Syntax_Util.branch pat) -in (_160_791)::[]) -in ((arg_exp), (_160_792))) -in FStar_Syntax_Syntax.Tm_match (_160_793)) -in (FStar_Syntax_Syntax.mk _160_794 None p)) +let body = (let _160_819 = (let _160_818 = (let _160_817 = (let _160_816 = (FStar_Syntax_Util.branch pat) +in (_160_816)::[]) +in ((arg_exp), (_160_817))) +in FStar_Syntax_Syntax.Tm_match (_160_818)) +in (FStar_Syntax_Syntax.mk _160_819 None p)) in ( let imp = (no_annot_abs binders body) @@ -2895,16 +2906,16 @@ FStar_Syntax_Syntax.Delta_equational end in ( -let lb = (let _160_796 = (let _160_795 = (FStar_Syntax_Syntax.lid_as_fv field_name dd None) -in FStar_Util.Inr (_160_795)) -in {FStar_Syntax_Syntax.lbname = _160_796; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = FStar_Syntax_Syntax.tun; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_Tot_lid; FStar_Syntax_Syntax.lbdef = imp}) +let lb = (let _160_821 = (let _160_820 = (FStar_Syntax_Syntax.lid_as_fv field_name dd None) +in FStar_Util.Inr (_160_820)) +in {FStar_Syntax_Syntax.lbname = _160_821; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = FStar_Syntax_Syntax.tun; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_Tot_lid; FStar_Syntax_Syntax.lbdef = imp}) in ( -let impl = (let _160_801 = (let _160_800 = (let _160_799 = (let _160_798 = (FStar_All.pipe_right lb.FStar_Syntax_Syntax.lbname FStar_Util.right) -in (FStar_All.pipe_right _160_798 (fun fv -> fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v))) -in (_160_799)::[]) -in ((((false), ((lb)::[]))), (p), (_160_800), (quals))) -in FStar_Syntax_Syntax.Sig_let (_160_801)) +let impl = (let _160_826 = (let _160_825 = (let _160_824 = (let _160_823 = (FStar_All.pipe_right lb.FStar_Syntax_Syntax.lbname FStar_Util.right) +in (FStar_All.pipe_right _160_823 (fun fv -> fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v))) +in (_160_824)::[]) +in ((((false), ((lb)::[]))), (p), (_160_825), (quals))) +in FStar_Syntax_Syntax.Sig_let (_160_826)) in if no_decl then begin (impl)::[] end else begin @@ -2913,21 +2924,21 @@ end)))))))) end)))))) end)) end)))) -in (FStar_All.pipe_right _160_802 FStar_List.flatten))))))))) +in (FStar_All.pipe_right _160_827 FStar_List.flatten))))))))) end))))))) -let mk_data_projectors : FStar_Syntax_Syntax.qualifier Prims.list -> FStar_Parser_Env.env -> (FStar_Syntax_Syntax.binders * FStar_Syntax_Syntax.sigelt) -> FStar_Syntax_Syntax.sigelt Prims.list = (fun iquals env _65_2116 -> (match (_65_2116) with +let mk_data_projectors : FStar_Syntax_Syntax.qualifier Prims.list -> FStar_Parser_Env.env -> (FStar_Syntax_Syntax.binders * FStar_Syntax_Syntax.sigelt) -> FStar_Syntax_Syntax.sigelt Prims.list = (fun iquals env _65_2121 -> (match (_65_2121) with | (inductive_tps, se) -> begin (match (se) with -| FStar_Syntax_Syntax.Sig_datacon (lid, _65_2119, t, l, n, quals, _65_2125, _65_2127) when (not ((FStar_Ident.lid_equals lid FStar_Syntax_Const.lexcons_lid))) -> begin +| FStar_Syntax_Syntax.Sig_datacon (lid, _65_2124, t, l, n, quals, _65_2130, _65_2132) when (not ((FStar_Ident.lid_equals lid FStar_Syntax_Const.lexcons_lid))) -> begin ( let refine_domain = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _65_14 -> (match (_65_14) with -| FStar_Syntax_Syntax.RecordConstructor (_65_2132) -> begin +| FStar_Syntax_Syntax.RecordConstructor (_65_2137) -> begin true end -| _65_2135 -> begin +| _65_2140 -> begin false end)))) then begin false @@ -2936,27 +2947,27 @@ end else begin | Some (l) -> begin ((FStar_List.length l) > (Prims.parse_int "1")) end -| _65_2139 -> begin +| _65_2144 -> begin true end) end in ( -let _65_2143 = (FStar_Syntax_Util.arrow_formals t) -in (match (_65_2143) with +let _65_2148 = (FStar_Syntax_Util.arrow_formals t) +in (match (_65_2148) with | (formals, cod) -> begin (match (formals) with | [] -> begin [] end -| _65_2146 -> begin +| _65_2151 -> begin ( let fv_qual = (match ((FStar_Util.find_map quals (fun _65_15 -> (match (_65_15) with | FStar_Syntax_Syntax.RecordConstructor (fns) -> begin Some (FStar_Syntax_Syntax.Record_ctor (((lid), (fns)))) end -| _65_2151 -> begin +| _65_2156 -> begin None end)))) with | None -> begin @@ -2974,15 +2985,15 @@ iquals end in ( -let _65_2159 = (FStar_Util.first_N n formals) -in (match (_65_2159) with +let _65_2164 = (FStar_Util.first_N n formals) +in (match (_65_2164) with | (tps, rest) -> begin (mk_indexed_projectors iquals fv_qual refine_domain env l lid inductive_tps tps rest cod) end)))) end) end))) end -| _65_2161 -> begin +| _65_2166 -> begin [] end) end)) @@ -2991,19 +3002,19 @@ end)) let mk_typ_abbrev : FStar_Ident.lident -> FStar_Syntax_Syntax.univ_name Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.term -> FStar_Ident.lident Prims.list -> FStar_Syntax_Syntax.qualifier Prims.list -> FStar_Range.range -> FStar_Syntax_Syntax.sigelt = (fun lid uvs typars k t lids quals rng -> ( let dd = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Abstract)) then begin -(let _160_827 = (FStar_Syntax_Util.incr_delta_qualifier t) -in FStar_Syntax_Syntax.Delta_abstract (_160_827)) +(let _160_852 = (FStar_Syntax_Util.incr_delta_qualifier t) +in FStar_Syntax_Syntax.Delta_abstract (_160_852)) end else begin (FStar_Syntax_Util.incr_delta_qualifier t) end in ( -let lb = (let _160_832 = (let _160_828 = (FStar_Syntax_Syntax.lid_as_fv lid dd None) -in FStar_Util.Inr (_160_828)) -in (let _160_831 = (let _160_829 = (FStar_Syntax_Syntax.mk_Total k) -in (FStar_Syntax_Util.arrow typars _160_829)) -in (let _160_830 = (no_annot_abs typars t) -in {FStar_Syntax_Syntax.lbname = _160_832; FStar_Syntax_Syntax.lbunivs = uvs; FStar_Syntax_Syntax.lbtyp = _160_831; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_Tot_lid; FStar_Syntax_Syntax.lbdef = _160_830}))) +let lb = (let _160_857 = (let _160_853 = (FStar_Syntax_Syntax.lid_as_fv lid dd None) +in FStar_Util.Inr (_160_853)) +in (let _160_856 = (let _160_854 = (FStar_Syntax_Syntax.mk_Total k) +in (FStar_Syntax_Util.arrow typars _160_854)) +in (let _160_855 = (no_annot_abs typars t) +in {FStar_Syntax_Syntax.lbname = _160_857; FStar_Syntax_Syntax.lbunivs = uvs; FStar_Syntax_Syntax.lbtyp = _160_856; FStar_Syntax_Syntax.lbeff = FStar_Syntax_Const.effect_Tot_lid; FStar_Syntax_Syntax.lbdef = _160_855}))) in FStar_Syntax_Syntax.Sig_let (((((false), ((lb)::[]))), (rng), (lids), (quals)))))) @@ -3017,9 +3028,9 @@ in ( let binder_to_term = (fun b -> (match (b.FStar_Parser_AST.b) with | (FStar_Parser_AST.Annotated (x, _)) | (FStar_Parser_AST.Variable (x)) -> begin -(let _160_846 = (let _160_845 = (FStar_Ident.lid_of_ids ((x)::[])) -in FStar_Parser_AST.Var (_160_845)) -in (FStar_Parser_AST.mk_term _160_846 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) +(let _160_871 = (let _160_870 = (FStar_Ident.lid_of_ids ((x)::[])) +in FStar_Parser_AST.Var (_160_870)) +in (FStar_Parser_AST.mk_term _160_871 x.FStar_Ident.idRange FStar_Parser_AST.Expr)) end | (FStar_Parser_AST.TAnnotated (a, _)) | (FStar_Parser_AST.TVariable (a)) -> begin (FStar_Parser_AST.mk_term (FStar_Parser_AST.Tvar (a)) a.FStar_Ident.idRange FStar_Parser_AST.Type) @@ -3041,13 +3052,13 @@ let imp_of_aqual = (fun b -> (match (b.FStar_Parser_AST.aqual) with | Some (FStar_Parser_AST.Implicit) -> begin FStar_Parser_AST.Hash end -| _65_2236 -> begin +| _65_2241 -> begin FStar_Parser_AST.Nothing end)) -in (FStar_List.fold_left (fun out b -> (let _160_859 = (let _160_858 = (let _160_857 = (binder_to_term b) -in ((out), (_160_857), ((imp_of_aqual b)))) -in FStar_Parser_AST.App (_160_858)) -in (FStar_Parser_AST.mk_term _160_859 out.FStar_Parser_AST.range out.FStar_Parser_AST.level))) t binders))) +in (FStar_List.fold_left (fun out b -> (let _160_884 = (let _160_883 = (let _160_882 = (binder_to_term b) +in ((out), (_160_882), ((imp_of_aqual b)))) +in FStar_Parser_AST.App (_160_883)) +in (FStar_Parser_AST.mk_term _160_884 out.FStar_Parser_AST.range out.FStar_Parser_AST.level))) t binders))) in ( let tycon_record_as_variant = (fun _65_17 -> (match (_65_17) with @@ -3057,26 +3068,26 @@ let tycon_record_as_variant = (fun _65_17 -> (match (_65_17) with let constrName = (FStar_Ident.mk_ident (((Prims.strcat "Mk" id.FStar_Ident.idText)), (id.FStar_Ident.idRange))) in ( -let mfields = (FStar_List.map (fun _65_2251 -> (match (_65_2251) with -| (x, t, _65_2250) -> begin +let mfields = (FStar_List.map (fun _65_2256 -> (match (_65_2256) with +| (x, t, _65_2255) -> begin (FStar_Parser_AST.mk_binder (FStar_Parser_AST.Annotated ((((FStar_Syntax_Util.mangle_field_name x)), (t)))) x.FStar_Ident.idRange FStar_Parser_AST.Expr None) end)) fields) in ( -let result = (let _160_865 = (let _160_864 = (let _160_863 = (FStar_Ident.lid_of_ids ((id)::[])) -in FStar_Parser_AST.Var (_160_863)) -in (FStar_Parser_AST.mk_term _160_864 id.FStar_Ident.idRange FStar_Parser_AST.Type)) -in (apply_binders _160_865 parms)) +let result = (let _160_890 = (let _160_889 = (let _160_888 = (FStar_Ident.lid_of_ids ((id)::[])) +in FStar_Parser_AST.Var (_160_888)) +in (FStar_Parser_AST.mk_term _160_889 id.FStar_Ident.idRange FStar_Parser_AST.Type)) +in (apply_binders _160_890 parms)) in ( let constrTyp = (FStar_Parser_AST.mk_term (FStar_Parser_AST.Product (((mfields), ((with_constructor_effect result))))) id.FStar_Ident.idRange FStar_Parser_AST.Type) -in (let _160_867 = (FStar_All.pipe_right fields (FStar_List.map (fun _65_2260 -> (match (_65_2260) with -| (x, _65_2257, _65_2259) -> begin +in (let _160_892 = (FStar_All.pipe_right fields (FStar_List.map (fun _65_2265 -> (match (_65_2265) with +| (x, _65_2262, _65_2264) -> begin (FStar_Parser_Env.qualify env x) end)))) -in ((FStar_Parser_AST.TyconVariant (((id), (parms), (kopt), ((((constrName), (Some (constrTyp)), (None), (false)))::[])))), (_160_867))))))) +in ((FStar_Parser_AST.TyconVariant (((id), (parms), (kopt), ((((constrName), (Some (constrTyp)), (None), (false)))::[])))), (_160_892))))))) end -| _65_2262 -> begin +| _65_2267 -> begin (FStar_All.failwith "impossible") end)) in ( @@ -3085,8 +3096,8 @@ let desugar_abstract_tc = (fun quals _env mutuals _65_18 -> (match (_65_18) with | FStar_Parser_AST.TyconAbstract (id, binders, kopt) -> begin ( -let _65_2276 = (typars_of_binders _env binders) -in (match (_65_2276) with +let _65_2281 = (typars_of_binders _env binders) +in (match (_65_2281) with | (_env', typars) -> begin ( @@ -3099,10 +3110,10 @@ end end) in ( -let tconstr = (let _160_878 = (let _160_877 = (let _160_876 = (FStar_Ident.lid_of_ids ((id)::[])) -in FStar_Parser_AST.Var (_160_876)) -in (FStar_Parser_AST.mk_term _160_877 id.FStar_Ident.idRange FStar_Parser_AST.Type)) -in (apply_binders _160_878 binders)) +let tconstr = (let _160_903 = (let _160_902 = (let _160_901 = (FStar_Ident.lid_of_ids ((id)::[])) +in FStar_Parser_AST.Var (_160_901)) +in (FStar_Parser_AST.mk_term _160_902 id.FStar_Ident.idRange FStar_Parser_AST.Type)) +in (apply_binders _160_903 binders)) in ( let qlid = (FStar_Parser_Env.qualify _env id) @@ -3124,24 +3135,24 @@ let _env2 = (FStar_Parser_Env.push_top_level_rec_binding _env' id FStar_Syntax_S in ((_env), (_env2), (se), (tconstr)))))))))) end)) end -| _65_2289 -> begin +| _65_2294 -> begin (FStar_All.failwith "Unexpected tycon") end)) in ( let push_tparams = (fun env bs -> ( -let _65_2304 = (FStar_List.fold_left (fun _65_2295 _65_2298 -> (match (((_65_2295), (_65_2298))) with +let _65_2309 = (FStar_List.fold_left (fun _65_2300 _65_2303 -> (match (((_65_2300), (_65_2303))) with | ((env, tps), (x, imp)) -> begin ( -let _65_2301 = (FStar_Parser_Env.push_bv env x.FStar_Syntax_Syntax.ppname) -in (match (_65_2301) with +let _65_2306 = (FStar_Parser_Env.push_bv env x.FStar_Syntax_Syntax.ppname) +in (match (_65_2306) with | (env, y) -> begin ((env), ((((y), (imp)))::tps)) end)) end)) ((env), ([])) bs) -in (match (_65_2304) with +in (match (_65_2309) with | (env, bs) -> begin ((env), ((FStar_List.rev bs))) end))) @@ -3151,10 +3162,10 @@ in (match (tcs) with let kopt = (match (kopt) with | None -> begin -(let _160_885 = (tm_type_z id.FStar_Ident.idRange) -in Some (_160_885)) +(let _160_910 = (tm_type_z id.FStar_Ident.idRange) +in Some (_160_910)) end -| _65_2313 -> begin +| _65_2318 -> begin kopt end) in ( @@ -3162,13 +3173,13 @@ in ( let tc = FStar_Parser_AST.TyconAbstract (((id), (bs), (kopt))) in ( -let _65_2323 = (desugar_abstract_tc quals env [] tc) -in (match (_65_2323) with -| (_65_2317, _65_2319, se, _65_2322) -> begin +let _65_2328 = (desugar_abstract_tc quals env [] tc) +in (match (_65_2328) with +| (_65_2322, _65_2324, se, _65_2327) -> begin ( let se = (match (se) with -| FStar_Syntax_Syntax.Sig_inductive_typ (l, _65_2326, typars, k, [], [], quals, rng) -> begin +| FStar_Syntax_Syntax.Sig_inductive_typ (l, _65_2331, typars, k, [], [], quals, rng) -> begin ( let quals = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Assumption)) then begin @@ -3176,9 +3187,9 @@ quals end else begin ( -let _65_2335 = (let _160_887 = (FStar_Range.string_of_range rng) -in (let _160_886 = (FStar_Syntax_Print.lid_to_string l) -in (FStar_Util.print2 "%s (Warning): Adding an implicit \'assume new\' qualifier on %s\n" _160_887 _160_886))) +let _65_2340 = (let _160_912 = (FStar_Range.string_of_range rng) +in (let _160_911 = (FStar_Syntax_Print.lid_to_string l) +in (FStar_Util.print2 "%s (Warning): Adding an implicit \'assume new\' qualifier on %s\n" _160_912 _160_911))) in (FStar_Syntax_Syntax.Assumption)::(FStar_Syntax_Syntax.New)::quals) end in ( @@ -3187,15 +3198,15 @@ let t = (match (typars) with | [] -> begin k end -| _65_2340 -> begin -(let _160_890 = (let _160_889 = (let _160_888 = (FStar_Syntax_Syntax.mk_Total k) -in ((typars), (_160_888))) -in FStar_Syntax_Syntax.Tm_arrow (_160_889)) -in (FStar_Syntax_Syntax.mk _160_890 None rng)) +| _65_2345 -> begin +(let _160_915 = (let _160_914 = (let _160_913 = (FStar_Syntax_Syntax.mk_Total k) +in ((typars), (_160_913))) +in FStar_Syntax_Syntax.Tm_arrow (_160_914)) +in (FStar_Syntax_Syntax.mk _160_915 None rng)) end) in FStar_Syntax_Syntax.Sig_declare_typ (((l), ([]), (t), (quals), (rng))))) end -| _65_2343 -> begin +| _65_2348 -> begin se end) in ( @@ -3207,8 +3218,8 @@ end | (FStar_Parser_AST.TyconAbbrev (id, binders, kopt, t))::[] -> begin ( -let _65_2355 = (typars_of_binders env binders) -in (match (_65_2355) with +let _65_2360 = (typars_of_binders env binders) +in (match (_65_2360) with | (env', typars) -> begin ( @@ -3218,7 +3229,7 @@ if (FStar_Util.for_some (fun _65_19 -> (match (_65_19) with | FStar_Syntax_Syntax.Effect -> begin true end -| _65_2360 -> begin +| _65_2365 -> begin false end)) quals) then begin FStar_Syntax_Syntax.teff @@ -3238,7 +3249,7 @@ let quals = if (FStar_All.pipe_right quals (FStar_Util.for_some (fun _65_20 -> ( | FStar_Syntax_Syntax.Logic -> begin true end -| _65_2368 -> begin +| _65_2373 -> begin false end)))) then begin quals @@ -3261,16 +3272,16 @@ let typars = (FStar_Syntax_Subst.close_binders typars) in ( let c = (FStar_Syntax_Subst.close_comp typars c) -in (let _160_896 = (let _160_895 = (FStar_Parser_Env.qualify env id) -in (let _160_894 = (FStar_All.pipe_right quals (FStar_List.filter (fun _65_21 -> (match (_65_21) with +in (let _160_921 = (let _160_920 = (FStar_Parser_Env.qualify env id) +in (let _160_919 = (FStar_All.pipe_right quals (FStar_List.filter (fun _65_21 -> (match (_65_21) with | FStar_Syntax_Syntax.Effect -> begin false end -| _65_2376 -> begin +| _65_2381 -> begin true end)))) -in ((_160_895), ([]), (typars), (c), (_160_894), (rng)))) -in FStar_Syntax_Syntax.Sig_effect_abbrev (_160_896))))) +in ((_160_920), ([]), (typars), (c), (_160_919), (rng)))) +in FStar_Syntax_Syntax.Sig_effect_abbrev (_160_921))))) end else begin ( @@ -3286,19 +3297,19 @@ let env = (FStar_Parser_Env.push_sigelt env se) in ((env), ((se)::[]))))))) end)) end -| (FStar_Parser_AST.TyconRecord (_65_2382))::[] -> begin +| (FStar_Parser_AST.TyconRecord (_65_2387))::[] -> begin ( let trec = (FStar_List.hd tcs) in ( -let _65_2388 = (tycon_record_as_variant trec) -in (match (_65_2388) with +let _65_2393 = (tycon_record_as_variant trec) +in (match (_65_2393) with | (t, fs) -> begin (desugar_tycon env rng ((FStar_Syntax_Syntax.RecordType (fs))::quals) ((t)::[])) end))) end -| (_65_2392)::_65_2390 -> begin +| (_65_2397)::_65_2395 -> begin ( let env0 = env @@ -3309,18 +3320,18 @@ in ( let rec collect_tcs = (fun quals et tc -> ( -let _65_2403 = et -in (match (_65_2403) with +let _65_2408 = et +in (match (_65_2408) with | (env, tcs) -> begin (match (tc) with -| FStar_Parser_AST.TyconRecord (_65_2405) -> begin +| FStar_Parser_AST.TyconRecord (_65_2410) -> begin ( let trec = tc in ( -let _65_2410 = (tycon_record_as_variant trec) -in (match (_65_2410) with +let _65_2415 = (tycon_record_as_variant trec) +in (match (_65_2415) with | (t, fs) -> begin (collect_tcs ((FStar_Syntax_Syntax.RecordType (fs))::quals) ((env), (tcs)) t) end))) @@ -3328,29 +3339,29 @@ end | FStar_Parser_AST.TyconVariant (id, binders, kopt, constructors) -> begin ( -let _65_2422 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) -in (match (_65_2422) with -| (env, _65_2419, se, tconstr) -> begin +let _65_2427 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) +in (match (_65_2427) with +| (env, _65_2424, se, tconstr) -> begin ((env), ((FStar_Util.Inl (((se), (constructors), (tconstr), (quals))))::tcs)) end)) end | FStar_Parser_AST.TyconAbbrev (id, binders, kopt, t) -> begin ( -let _65_2434 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) -in (match (_65_2434) with -| (env, _65_2431, se, tconstr) -> begin +let _65_2439 = (desugar_abstract_tc quals env mutuals (FStar_Parser_AST.TyconAbstract (((id), (binders), (kopt))))) +in (match (_65_2439) with +| (env, _65_2436, se, tconstr) -> begin ((env), ((FStar_Util.Inr (((se), (t), (quals))))::tcs)) end)) end -| _65_2436 -> begin +| _65_2441 -> begin (FStar_All.failwith "Unrecognized mutual type definition") end) end))) in ( -let _65_2439 = (FStar_List.fold_left (collect_tcs quals) ((env), ([])) tcs) -in (match (_65_2439) with +let _65_2444 = (FStar_List.fold_left (collect_tcs quals) ((env), ([])) tcs) +in (match (_65_2444) with | (env, tcs) -> begin ( @@ -3358,39 +3369,39 @@ let tcs = (FStar_List.rev tcs) in ( let tps_sigelts = (FStar_All.pipe_right tcs (FStar_List.collect (fun _65_23 -> (match (_65_23) with -| FStar_Util.Inr (FStar_Syntax_Syntax.Sig_inductive_typ (id, uvs, tpars, k, _65_2447, _65_2449, _65_2451, _65_2453), t, quals) -> begin +| FStar_Util.Inr (FStar_Syntax_Syntax.Sig_inductive_typ (id, uvs, tpars, k, _65_2452, _65_2454, _65_2456, _65_2458), t, quals) -> begin ( -let _65_2463 = (push_tparams env tpars) -in (match (_65_2463) with -| (env_tps, _65_2462) -> begin +let _65_2468 = (push_tparams env tpars) +in (match (_65_2468) with +| (env_tps, _65_2467) -> begin ( let t = (desugar_term env_tps t) -in (let _160_906 = (let _160_905 = (mk_typ_abbrev id uvs tpars k t ((id)::[]) quals rng) -in (([]), (_160_905))) -in (_160_906)::[])) +in (let _160_931 = (let _160_930 = (mk_typ_abbrev id uvs tpars k t ((id)::[]) quals rng) +in (([]), (_160_930))) +in (_160_931)::[])) end)) end -| FStar_Util.Inl (FStar_Syntax_Syntax.Sig_inductive_typ (tname, univs, tpars, k, mutuals, _65_2471, tags, _65_2474), constrs, tconstr, quals) -> begin +| FStar_Util.Inl (FStar_Syntax_Syntax.Sig_inductive_typ (tname, univs, tpars, k, mutuals, _65_2476, tags, _65_2479), constrs, tconstr, quals) -> begin ( let tycon = ((tname), (tpars), (k)) in ( -let _65_2485 = (push_tparams env tpars) -in (match (_65_2485) with +let _65_2490 = (push_tparams env tpars) +in (match (_65_2490) with | (env_tps, tps) -> begin ( -let data_tpars = (FStar_List.map (fun _65_2489 -> (match (_65_2489) with -| (x, _65_2488) -> begin +let data_tpars = (FStar_List.map (fun _65_2494 -> (match (_65_2494) with +| (x, _65_2493) -> begin ((x), (Some (FStar_Syntax_Syntax.Implicit (true)))) end)) tps) in ( -let _65_2515 = (let _160_918 = (FStar_All.pipe_right constrs (FStar_List.map (fun _65_2496 -> (match (_65_2496) with -| (id, topt, _65_2494, of_notation) -> begin +let _65_2520 = (let _160_943 = (FStar_All.pipe_right constrs (FStar_List.map (fun _65_2501 -> (match (_65_2501) with +| (id, topt, _65_2499, of_notation) -> begin ( let t = if of_notation then begin @@ -3412,9 +3423,9 @@ end) end in ( -let t = (let _160_910 = (FStar_Parser_Env.default_total env_tps) -in (let _160_909 = (close env_tps t) -in (desugar_term _160_910 _160_909))) +let t = (let _160_935 = (FStar_Parser_Env.default_total env_tps) +in (let _160_934 = (close env_tps t) +in (desugar_term _160_935 _160_934))) in ( let name = (FStar_Parser_Env.qualify env id) @@ -3424,28 +3435,28 @@ let quals = (FStar_All.pipe_right tags (FStar_List.collect (fun _65_22 -> (match | FStar_Syntax_Syntax.RecordType (fns) -> begin (FStar_Syntax_Syntax.RecordConstructor (fns))::[] end -| _65_2510 -> begin +| _65_2515 -> begin [] end)))) in ( let ntps = (FStar_List.length data_tpars) -in (let _160_917 = (let _160_916 = (let _160_915 = (let _160_914 = (let _160_913 = (let _160_912 = (FStar_All.pipe_right t FStar_Syntax_Util.name_function_binders) -in (FStar_Syntax_Syntax.mk_Total _160_912)) -in (FStar_Syntax_Util.arrow data_tpars _160_913)) -in ((name), (univs), (_160_914), (tname), (ntps), (quals), (mutuals), (rng))) -in FStar_Syntax_Syntax.Sig_datacon (_160_915)) -in ((tps), (_160_916))) -in ((name), (_160_917)))))))) +in (let _160_942 = (let _160_941 = (let _160_940 = (let _160_939 = (let _160_938 = (let _160_937 = (FStar_All.pipe_right t FStar_Syntax_Util.name_function_binders) +in (FStar_Syntax_Syntax.mk_Total _160_937)) +in (FStar_Syntax_Util.arrow data_tpars _160_938)) +in ((name), (univs), (_160_939), (tname), (ntps), (quals), (mutuals), (rng))) +in FStar_Syntax_Syntax.Sig_datacon (_160_940)) +in ((tps), (_160_941))) +in ((name), (_160_942)))))))) end)))) -in (FStar_All.pipe_left FStar_List.split _160_918)) -in (match (_65_2515) with +in (FStar_All.pipe_left FStar_List.split _160_943)) +in (match (_65_2520) with | (constrNames, constrs) -> begin ((([]), (FStar_Syntax_Syntax.Sig_inductive_typ (((tname), (univs), (tpars), (k), (mutuals), (constrNames), (tags), (rng))))))::constrs end))) end))) end -| _65_2517 -> begin +| _65_2522 -> begin (FStar_All.failwith "impossible") end)))) in ( @@ -3453,9 +3464,9 @@ in ( let sigelts = (FStar_All.pipe_right tps_sigelts (FStar_List.map Prims.snd)) in ( -let bundle = (let _160_920 = (let _160_919 = (FStar_List.collect FStar_Syntax_Util.lids_of_sigelt sigelts) -in ((sigelts), (quals), (_160_919), (rng))) -in FStar_Syntax_Syntax.Sig_bundle (_160_920)) +let bundle = (let _160_945 = (let _160_944 = (FStar_List.collect FStar_Syntax_Util.lids_of_sigelt sigelts) +in ((sigelts), (quals), (_160_944), (rng))) +in FStar_Syntax_Syntax.Sig_bundle (_160_945)) in ( let env = (FStar_Parser_Env.push_sigelt env0 bundle) @@ -3465,7 +3476,7 @@ let data_ops = (FStar_All.pipe_right tps_sigelts (FStar_List.collect (mk_data_pr in ( let discs = (FStar_All.pipe_right sigelts (FStar_List.collect (fun _65_24 -> (match (_65_24) with -| FStar_Syntax_Syntax.Sig_inductive_typ (tname, _65_2526, tps, k, _65_2530, constrs, quals, _65_2534) when ((FStar_List.length constrs) > (Prims.parse_int "1")) -> begin +| FStar_Syntax_Syntax.Sig_inductive_typ (tname, _65_2531, tps, k, _65_2535, constrs, quals, _65_2539) when ((FStar_List.length constrs) > (Prims.parse_int "1")) -> begin ( let quals = if (FStar_List.contains FStar_Syntax_Syntax.Abstract quals) then begin @@ -3475,7 +3486,7 @@ quals end in (mk_data_discriminators quals env tname tps k constrs)) end -| _65_2539 -> begin +| _65_2544 -> begin [] end)))) in ( @@ -3494,28 +3505,28 @@ end)))))))))) let desugar_binders : FStar_Parser_Env.env -> FStar_Parser_AST.binder Prims.list -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.binder Prims.list) = (fun env binders -> ( -let _65_2563 = (FStar_List.fold_left (fun _65_2548 b -> (match (_65_2548) with +let _65_2568 = (FStar_List.fold_left (fun _65_2553 b -> (match (_65_2553) with | (env, binders) -> begin (match ((desugar_binder env b)) with | (Some (a), k) -> begin ( -let _65_2556 = (FStar_Parser_Env.push_bv env a) -in (match (_65_2556) with +let _65_2561 = (FStar_Parser_Env.push_bv env a) +in (match (_65_2561) with | (env, a) -> begin -(let _160_929 = (let _160_928 = (FStar_Syntax_Syntax.mk_binder ( +(let _160_954 = (let _160_953 = (FStar_Syntax_Syntax.mk_binder ( -let _65_2557 = a -in {FStar_Syntax_Syntax.ppname = _65_2557.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_2557.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k})) -in (_160_928)::binders) -in ((env), (_160_929))) +let _65_2562 = a +in {FStar_Syntax_Syntax.ppname = _65_2562.FStar_Syntax_Syntax.ppname; FStar_Syntax_Syntax.index = _65_2562.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = k})) +in (_160_953)::binders) +in ((env), (_160_954))) end)) end -| _65_2560 -> begin +| _65_2565 -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Missing name in binder"), (b.FStar_Parser_AST.brange))))) end) end)) ((env), ([])) binders) -in (match (_65_2563) with +in (match (_65_2568) with | (env, binders) -> begin ((env), ((FStar_List.rev binders))) end))) @@ -3529,28 +3540,28 @@ in ( let monad_env = (FStar_Parser_Env.enter_monad_scope env eff_name) in ( -let _65_2577 = (desugar_binders monad_env eff_binders) -in (match (_65_2577) with +let _65_2582 = (desugar_binders monad_env eff_binders) +in (match (_65_2582) with | (env, binders) -> begin ( -let eff_k = (let _160_964 = (FStar_Parser_Env.default_total env) -in (desugar_term _160_964 eff_kind)) +let eff_k = (let _160_992 = (FStar_Parser_Env.default_total env) +in (desugar_term _160_992 eff_kind)) in ( -let _65_2588 = (FStar_All.pipe_right eff_decls (FStar_List.fold_left (fun _65_2581 decl -> (match (_65_2581) with +let _65_2593 = (FStar_All.pipe_right eff_decls (FStar_List.fold_left (fun _65_2586 decl -> (match (_65_2586) with | (env, out) -> begin ( -let _65_2585 = (desugar_decl env decl) -in (match (_65_2585) with +let _65_2590 = (desugar_decl env decl) +in (match (_65_2590) with | (env, ses) -> begin -(let _160_968 = (let _160_967 = (FStar_List.hd ses) -in (_160_967)::out) -in ((env), (_160_968))) +(let _160_996 = (let _160_995 = (FStar_List.hd ses) +in (_160_995)::out) +in ((env), (_160_996))) end)) end)) ((env), ([])))) -in (match (_65_2588) with +in (match (_65_2593) with | (env, decls) -> begin ( @@ -3558,21 +3569,21 @@ let binders = (FStar_Syntax_Subst.close_binders binders) in ( let actions = (FStar_All.pipe_right actions (FStar_List.map (fun d -> (match (d.FStar_Parser_AST.d) with -| FStar_Parser_AST.Tycon (_65_2592, ((FStar_Parser_AST.TyconAbbrev (name, _65_2595, _65_2597, {FStar_Parser_AST.tm = FStar_Parser_AST.Construct (_65_2603, ((def, _65_2610))::((cps_type, _65_2606))::[]); FStar_Parser_AST.range = _65_2601; FStar_Parser_AST.level = _65_2599}), _65_2619))::[]) when (not (for_free)) -> begin -(let _160_974 = (FStar_Parser_Env.qualify env name) -in (let _160_973 = (let _160_970 = (desugar_term env def) -in (FStar_Syntax_Subst.close binders _160_970)) -in (let _160_972 = (let _160_971 = (desugar_typ env cps_type) -in (FStar_Syntax_Subst.close binders _160_971)) -in {FStar_Syntax_Syntax.action_name = _160_974; FStar_Syntax_Syntax.action_univs = []; FStar_Syntax_Syntax.action_defn = _160_973; FStar_Syntax_Syntax.action_typ = _160_972}))) -end -| FStar_Parser_AST.Tycon (_65_2625, ((FStar_Parser_AST.TyconAbbrev (name, _65_2628, _65_2630, defn), _65_2635))::[]) when for_free -> begin -(let _160_977 = (FStar_Parser_Env.qualify env name) -in (let _160_976 = (let _160_975 = (desugar_term env defn) -in (FStar_Syntax_Subst.close binders _160_975)) -in {FStar_Syntax_Syntax.action_name = _160_977; FStar_Syntax_Syntax.action_univs = []; FStar_Syntax_Syntax.action_defn = _160_976; FStar_Syntax_Syntax.action_typ = FStar_Syntax_Syntax.tun})) -end -| _65_2641 -> begin +| FStar_Parser_AST.Tycon (_65_2597, ((FStar_Parser_AST.TyconAbbrev (name, _65_2600, _65_2602, {FStar_Parser_AST.tm = FStar_Parser_AST.Construct (_65_2608, ((def, _65_2615))::((cps_type, _65_2611))::[]); FStar_Parser_AST.range = _65_2606; FStar_Parser_AST.level = _65_2604}), _65_2624))::[]) when (not (for_free)) -> begin +(let _160_1002 = (FStar_Parser_Env.qualify env name) +in (let _160_1001 = (let _160_998 = (desugar_term env def) +in (FStar_Syntax_Subst.close binders _160_998)) +in (let _160_1000 = (let _160_999 = (desugar_typ env cps_type) +in (FStar_Syntax_Subst.close binders _160_999)) +in {FStar_Syntax_Syntax.action_name = _160_1002; FStar_Syntax_Syntax.action_unqualified_name = name; FStar_Syntax_Syntax.action_univs = []; FStar_Syntax_Syntax.action_defn = _160_1001; FStar_Syntax_Syntax.action_typ = _160_1000}))) +end +| FStar_Parser_AST.Tycon (_65_2630, ((FStar_Parser_AST.TyconAbbrev (name, _65_2633, _65_2635, defn), _65_2640))::[]) when for_free -> begin +(let _160_1005 = (FStar_Parser_Env.qualify env name) +in (let _160_1004 = (let _160_1003 = (desugar_term env defn) +in (FStar_Syntax_Subst.close binders _160_1003)) +in {FStar_Syntax_Syntax.action_name = _160_1005; FStar_Syntax_Syntax.action_unqualified_name = name; FStar_Syntax_Syntax.action_univs = []; FStar_Syntax_Syntax.action_defn = _160_1004; FStar_Syntax_Syntax.action_typ = FStar_Syntax_Syntax.tun})) +end +| _65_2646 -> begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Malformed action declaration; if this is an \"effect for free\", just provide the direct-style declaration. If this is not an \"effect for free\", please provide a pair of the definition and its cps-type with arrows inserted in the right place (see examples)."), (d.FStar_Parser_AST.drange))))) end)))) in ( @@ -3583,73 +3594,73 @@ in ( let lookup = (fun s -> ( let l = (FStar_Parser_Env.qualify env (FStar_Ident.mk_ident ((s), (d.FStar_Parser_AST.drange)))) -in (let _160_981 = (let _160_980 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_definition env) l) -in (FStar_All.pipe_left (FStar_Syntax_Subst.close binders) _160_980)) -in (([]), (_160_981))))) +in (let _160_1009 = (let _160_1008 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_definition env) l) +in (FStar_All.pipe_left (FStar_Syntax_Subst.close binders) _160_1008)) +in (([]), (_160_1009))))) in ( let mname = (FStar_Parser_Env.qualify env0 eff_name) in ( -let qualifiers = (FStar_List.map (trans_qual d.FStar_Parser_AST.drange) quals) +let qualifiers = (FStar_List.map (trans_qual d.FStar_Parser_AST.drange (Some (mname))) quals) in ( let se = if for_free then begin ( -let dummy_tscheme = (let _160_982 = (FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown None FStar_Range.dummyRange) -in (([]), (_160_982))) -in (let _160_988 = (let _160_987 = (let _160_986 = (let _160_983 = (lookup "repr") -in (Prims.snd _160_983)) -in (let _160_985 = (lookup "return") -in (let _160_984 = (lookup "bind") -in {FStar_Syntax_Syntax.qualifiers = qualifiers; FStar_Syntax_Syntax.mname = mname; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = eff_k; FStar_Syntax_Syntax.ret_wp = dummy_tscheme; FStar_Syntax_Syntax.bind_wp = dummy_tscheme; FStar_Syntax_Syntax.if_then_else = dummy_tscheme; FStar_Syntax_Syntax.ite_wp = dummy_tscheme; FStar_Syntax_Syntax.stronger = dummy_tscheme; FStar_Syntax_Syntax.close_wp = dummy_tscheme; FStar_Syntax_Syntax.assert_p = dummy_tscheme; FStar_Syntax_Syntax.assume_p = dummy_tscheme; FStar_Syntax_Syntax.null_wp = dummy_tscheme; FStar_Syntax_Syntax.trivial = dummy_tscheme; FStar_Syntax_Syntax.repr = _160_986; FStar_Syntax_Syntax.return_repr = _160_985; FStar_Syntax_Syntax.bind_repr = _160_984; FStar_Syntax_Syntax.actions = actions}))) -in ((_160_987), (d.FStar_Parser_AST.drange))) -in FStar_Syntax_Syntax.Sig_new_effect_for_free (_160_988))) +let dummy_tscheme = (let _160_1010 = (FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown None FStar_Range.dummyRange) +in (([]), (_160_1010))) +in (let _160_1016 = (let _160_1015 = (let _160_1014 = (let _160_1011 = (lookup "repr") +in (Prims.snd _160_1011)) +in (let _160_1013 = (lookup "return") +in (let _160_1012 = (lookup "bind") +in {FStar_Syntax_Syntax.qualifiers = qualifiers; FStar_Syntax_Syntax.mname = mname; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = eff_k; FStar_Syntax_Syntax.ret_wp = dummy_tscheme; FStar_Syntax_Syntax.bind_wp = dummy_tscheme; FStar_Syntax_Syntax.if_then_else = dummy_tscheme; FStar_Syntax_Syntax.ite_wp = dummy_tscheme; FStar_Syntax_Syntax.stronger = dummy_tscheme; FStar_Syntax_Syntax.close_wp = dummy_tscheme; FStar_Syntax_Syntax.assert_p = dummy_tscheme; FStar_Syntax_Syntax.assume_p = dummy_tscheme; FStar_Syntax_Syntax.null_wp = dummy_tscheme; FStar_Syntax_Syntax.trivial = dummy_tscheme; FStar_Syntax_Syntax.repr = _160_1014; FStar_Syntax_Syntax.return_repr = _160_1013; FStar_Syntax_Syntax.bind_repr = _160_1012; FStar_Syntax_Syntax.actions = actions}))) +in ((_160_1015), (d.FStar_Parser_AST.drange))) +in FStar_Syntax_Syntax.Sig_new_effect_for_free (_160_1016))) end else begin ( -let rr = ((FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) || (FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reflectable))) +let rr = ((FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable)) || (FStar_All.pipe_right qualifiers FStar_Syntax_Syntax.contains_reflectable)) in ( let un_ts = (([]), (FStar_Syntax_Syntax.tun)) -in (let _160_1004 = (let _160_1003 = (let _160_1002 = (lookup "return_wp") -in (let _160_1001 = (lookup "bind_wp") -in (let _160_1000 = (lookup "if_then_else") -in (let _160_999 = (lookup "ite_wp") -in (let _160_998 = (lookup "stronger") -in (let _160_997 = (lookup "close_wp") -in (let _160_996 = (lookup "assert_p") -in (let _160_995 = (lookup "assume_p") -in (let _160_994 = (lookup "null_wp") -in (let _160_993 = (lookup "trivial") -in (let _160_992 = if rr then begin -(let _160_989 = (lookup "repr") -in (FStar_All.pipe_left Prims.snd _160_989)) +in (let _160_1032 = (let _160_1031 = (let _160_1030 = (lookup "return_wp") +in (let _160_1029 = (lookup "bind_wp") +in (let _160_1028 = (lookup "if_then_else") +in (let _160_1027 = (lookup "ite_wp") +in (let _160_1026 = (lookup "stronger") +in (let _160_1025 = (lookup "close_wp") +in (let _160_1024 = (lookup "assert_p") +in (let _160_1023 = (lookup "assume_p") +in (let _160_1022 = (lookup "null_wp") +in (let _160_1021 = (lookup "trivial") +in (let _160_1020 = if rr then begin +(let _160_1017 = (lookup "repr") +in (FStar_All.pipe_left Prims.snd _160_1017)) end else begin FStar_Syntax_Syntax.tun end -in (let _160_991 = if rr then begin +in (let _160_1019 = if rr then begin (lookup "return") end else begin un_ts end -in (let _160_990 = if rr then begin +in (let _160_1018 = if rr then begin (lookup "bind") end else begin un_ts end -in {FStar_Syntax_Syntax.qualifiers = qualifiers; FStar_Syntax_Syntax.mname = mname; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = eff_k; FStar_Syntax_Syntax.ret_wp = _160_1002; FStar_Syntax_Syntax.bind_wp = _160_1001; FStar_Syntax_Syntax.if_then_else = _160_1000; FStar_Syntax_Syntax.ite_wp = _160_999; FStar_Syntax_Syntax.stronger = _160_998; FStar_Syntax_Syntax.close_wp = _160_997; FStar_Syntax_Syntax.assert_p = _160_996; FStar_Syntax_Syntax.assume_p = _160_995; FStar_Syntax_Syntax.null_wp = _160_994; FStar_Syntax_Syntax.trivial = _160_993; FStar_Syntax_Syntax.repr = _160_992; FStar_Syntax_Syntax.return_repr = _160_991; FStar_Syntax_Syntax.bind_repr = _160_990; FStar_Syntax_Syntax.actions = actions}))))))))))))) -in ((_160_1003), (d.FStar_Parser_AST.drange))) -in FStar_Syntax_Syntax.Sig_new_effect (_160_1004)))) +in {FStar_Syntax_Syntax.qualifiers = qualifiers; FStar_Syntax_Syntax.mname = mname; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = eff_k; FStar_Syntax_Syntax.ret_wp = _160_1030; FStar_Syntax_Syntax.bind_wp = _160_1029; FStar_Syntax_Syntax.if_then_else = _160_1028; FStar_Syntax_Syntax.ite_wp = _160_1027; FStar_Syntax_Syntax.stronger = _160_1026; FStar_Syntax_Syntax.close_wp = _160_1025; FStar_Syntax_Syntax.assert_p = _160_1024; FStar_Syntax_Syntax.assume_p = _160_1023; FStar_Syntax_Syntax.null_wp = _160_1022; FStar_Syntax_Syntax.trivial = _160_1021; FStar_Syntax_Syntax.repr = _160_1020; FStar_Syntax_Syntax.return_repr = _160_1019; FStar_Syntax_Syntax.bind_repr = _160_1018; FStar_Syntax_Syntax.actions = actions}))))))))))))) +in ((_160_1031), (d.FStar_Parser_AST.drange))) +in FStar_Syntax_Syntax.Sig_new_effect (_160_1032)))) end in ( let env = (FStar_Parser_Env.push_sigelt env0 se) in ( -let env = (FStar_All.pipe_right actions (FStar_List.fold_left (fun env a -> (let _160_1007 = (FStar_Syntax_Util.action_as_lb a) -in (FStar_Parser_Env.push_sigelt env _160_1007))) env)) +let env = (FStar_All.pipe_right actions (FStar_List.fold_left (fun env a -> (let _160_1035 = (FStar_Syntax_Util.action_as_lb a) +in (FStar_Parser_Env.push_sigelt env _160_1035))) env)) in ( let env = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Parser_AST.Reflectable)) then begin @@ -3658,7 +3669,7 @@ let env = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Parser_AST.R let reflect_lid = (FStar_All.pipe_right (FStar_Ident.id_of_text "reflect") (FStar_Parser_Env.qualify monad_env)) in ( -let refl_decl = FStar_Syntax_Syntax.Sig_declare_typ (((reflect_lid), ([]), (FStar_Syntax_Syntax.tun), ((FStar_Syntax_Syntax.Assumption)::(FStar_Syntax_Syntax.Reflectable)::[]), (d.FStar_Parser_AST.drange))) +let refl_decl = FStar_Syntax_Syntax.Sig_declare_typ (((reflect_lid), ([]), (FStar_Syntax_Syntax.tun), ((FStar_Syntax_Syntax.Assumption)::(FStar_Syntax_Syntax.Reflectable (mname))::[]), (d.FStar_Parser_AST.drange))) in (FStar_Parser_Env.push_sigelt env refl_decl))) end else begin env @@ -3666,7 +3677,7 @@ end in ((env), ((se)::[])))))))))))) end))) end))))) -and desugar_redefine_effect : FStar_Parser_Env.env -> FStar_Parser_AST.decl -> (FStar_Parser_AST.qualifier -> FStar_Syntax_Syntax.qualifier) -> FStar_Parser_AST.qualifier Prims.list -> FStar_Ident.ident -> FStar_Parser_AST.binder Prims.list -> FStar_Parser_AST.term -> (FStar_Syntax_Syntax.eff_decl -> FStar_Range.range -> FStar_Syntax_Syntax.sigelt) -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.sigelt Prims.list) = (fun env d trans_qual quals eff_name eff_binders defn build_sigelt -> ( +and desugar_redefine_effect : FStar_Parser_Env.env -> FStar_Parser_AST.decl -> (FStar_Ident.lident Prims.option -> FStar_Parser_AST.qualifier -> FStar_Syntax_Syntax.qualifier) -> FStar_Parser_AST.qualifier Prims.list -> FStar_Ident.ident -> FStar_Parser_AST.binder Prims.list -> FStar_Parser_AST.term -> (FStar_Syntax_Syntax.eff_decl -> FStar_Range.range -> FStar_Syntax_Syntax.sigelt) -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.sigelt Prims.list) = (fun env d trans_qual quals eff_name eff_binders defn build_sigelt -> ( let env0 = env in ( @@ -3674,15 +3685,15 @@ in ( let env = (FStar_Parser_Env.enter_monad_scope env eff_name) in ( -let _65_2672 = (desugar_binders env eff_binders) -in (match (_65_2672) with +let _65_2677 = (desugar_binders env eff_binders) +in (match (_65_2677) with | (env, binders) -> begin ( -let _65_2683 = ( +let _65_2688 = ( -let _65_2675 = (head_and_args defn) -in (match (_65_2675) with +let _65_2680 = (head_and_args defn) +in (match (_65_2680) with | (head, args) -> begin ( @@ -3690,34 +3701,34 @@ let ed = (match (head.FStar_Parser_AST.tm) with | FStar_Parser_AST.Name (l) -> begin (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_effect_defn env) l) end -| _65_2679 -> begin -(let _160_1029 = (let _160_1028 = (let _160_1027 = (let _160_1026 = (let _160_1025 = (FStar_Parser_AST.term_to_string head) -in (Prims.strcat _160_1025 " not found")) -in (Prims.strcat "Effect " _160_1026)) -in ((_160_1027), (d.FStar_Parser_AST.drange))) -in FStar_Syntax_Syntax.Error (_160_1028)) -in (Prims.raise _160_1029)) +| _65_2684 -> begin +(let _160_1062 = (let _160_1061 = (let _160_1060 = (let _160_1059 = (let _160_1058 = (FStar_Parser_AST.term_to_string head) +in (Prims.strcat _160_1058 " not found")) +in (Prims.strcat "Effect " _160_1059)) +in ((_160_1060), (d.FStar_Parser_AST.drange))) +in FStar_Syntax_Syntax.Error (_160_1061)) +in (Prims.raise _160_1062)) end) -in (let _160_1030 = (desugar_args env args) -in ((ed), (_160_1030)))) +in (let _160_1063 = (desugar_args env args) +in ((ed), (_160_1063)))) end)) -in (match (_65_2683) with +in (match (_65_2688) with | (ed, args) -> begin ( let binders = (FStar_Syntax_Subst.close_binders binders) in ( -let sub = (fun _65_2689 -> (match (_65_2689) with -| (_65_2687, x) -> begin +let sub = (fun _65_2694 -> (match (_65_2694) with +| (_65_2692, x) -> begin ( -let _65_2692 = (FStar_Syntax_Subst.open_term ed.FStar_Syntax_Syntax.binders x) -in (match (_65_2692) with +let _65_2697 = (FStar_Syntax_Subst.open_term ed.FStar_Syntax_Syntax.binders x) +in (match (_65_2697) with | (edb, x) -> begin ( -let _65_2693 = if ((FStar_List.length args) <> (FStar_List.length edb)) then begin +let _65_2698 = if ((FStar_List.length args) <> (FStar_List.length edb)) then begin (Prims.raise (FStar_Syntax_Syntax.Error ((("Unexpected number of arguments to effect constructor"), (defn.FStar_Parser_AST.range))))) end else begin () @@ -3725,38 +3736,41 @@ end in ( let s = (FStar_Syntax_Util.subst_of_list edb args) -in (let _160_1034 = (let _160_1033 = (FStar_Syntax_Subst.subst s x) -in (FStar_Syntax_Subst.close binders _160_1033)) -in (([]), (_160_1034))))) +in (let _160_1067 = (let _160_1066 = (FStar_Syntax_Subst.subst s x) +in (FStar_Syntax_Subst.close binders _160_1066)) +in (([]), (_160_1067))))) end)) end)) in ( -let ed = (let _160_1059 = (FStar_List.map trans_qual quals) -in (let _160_1058 = (FStar_Parser_Env.qualify env0 eff_name) -in (let _160_1057 = (let _160_1035 = (sub (([]), (ed.FStar_Syntax_Syntax.signature))) -in (Prims.snd _160_1035)) -in (let _160_1056 = (sub ed.FStar_Syntax_Syntax.ret_wp) -in (let _160_1055 = (sub ed.FStar_Syntax_Syntax.bind_wp) -in (let _160_1054 = (sub ed.FStar_Syntax_Syntax.if_then_else) -in (let _160_1053 = (sub ed.FStar_Syntax_Syntax.ite_wp) -in (let _160_1052 = (sub ed.FStar_Syntax_Syntax.stronger) -in (let _160_1051 = (sub ed.FStar_Syntax_Syntax.close_wp) -in (let _160_1050 = (sub ed.FStar_Syntax_Syntax.assert_p) -in (let _160_1049 = (sub ed.FStar_Syntax_Syntax.assume_p) -in (let _160_1048 = (sub ed.FStar_Syntax_Syntax.null_wp) -in (let _160_1047 = (sub ed.FStar_Syntax_Syntax.trivial) -in (let _160_1046 = (let _160_1036 = (sub (([]), (ed.FStar_Syntax_Syntax.repr))) -in (Prims.snd _160_1036)) -in (let _160_1045 = (sub ed.FStar_Syntax_Syntax.return_repr) -in (let _160_1044 = (sub ed.FStar_Syntax_Syntax.bind_repr) -in (let _160_1043 = (FStar_List.map (fun action -> (let _160_1042 = (FStar_Parser_Env.qualify env action.FStar_Syntax_Syntax.action_name.FStar_Ident.ident) -in (let _160_1041 = (let _160_1038 = (sub (([]), (action.FStar_Syntax_Syntax.action_defn))) -in (Prims.snd _160_1038)) -in (let _160_1040 = (let _160_1039 = (sub (([]), (action.FStar_Syntax_Syntax.action_typ))) -in (Prims.snd _160_1039)) -in {FStar_Syntax_Syntax.action_name = _160_1042; FStar_Syntax_Syntax.action_univs = action.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _160_1041; FStar_Syntax_Syntax.action_typ = _160_1040})))) ed.FStar_Syntax_Syntax.actions) -in {FStar_Syntax_Syntax.qualifiers = _160_1059; FStar_Syntax_Syntax.mname = _160_1058; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = _160_1057; FStar_Syntax_Syntax.ret_wp = _160_1056; FStar_Syntax_Syntax.bind_wp = _160_1055; FStar_Syntax_Syntax.if_then_else = _160_1054; FStar_Syntax_Syntax.ite_wp = _160_1053; FStar_Syntax_Syntax.stronger = _160_1052; FStar_Syntax_Syntax.close_wp = _160_1051; FStar_Syntax_Syntax.assert_p = _160_1050; FStar_Syntax_Syntax.assume_p = _160_1049; FStar_Syntax_Syntax.null_wp = _160_1048; FStar_Syntax_Syntax.trivial = _160_1047; FStar_Syntax_Syntax.repr = _160_1046; FStar_Syntax_Syntax.return_repr = _160_1045; FStar_Syntax_Syntax.bind_repr = _160_1044; FStar_Syntax_Syntax.actions = _160_1043}))))))))))))))))) +let mname = (FStar_Parser_Env.qualify env0 eff_name) +in ( + +let ed = (let _160_1092 = (let _160_1068 = (trans_qual (Some (mname))) +in (FStar_List.map _160_1068 quals)) +in (let _160_1091 = (let _160_1069 = (sub (([]), (ed.FStar_Syntax_Syntax.signature))) +in (Prims.snd _160_1069)) +in (let _160_1090 = (sub ed.FStar_Syntax_Syntax.ret_wp) +in (let _160_1089 = (sub ed.FStar_Syntax_Syntax.bind_wp) +in (let _160_1088 = (sub ed.FStar_Syntax_Syntax.if_then_else) +in (let _160_1087 = (sub ed.FStar_Syntax_Syntax.ite_wp) +in (let _160_1086 = (sub ed.FStar_Syntax_Syntax.stronger) +in (let _160_1085 = (sub ed.FStar_Syntax_Syntax.close_wp) +in (let _160_1084 = (sub ed.FStar_Syntax_Syntax.assert_p) +in (let _160_1083 = (sub ed.FStar_Syntax_Syntax.assume_p) +in (let _160_1082 = (sub ed.FStar_Syntax_Syntax.null_wp) +in (let _160_1081 = (sub ed.FStar_Syntax_Syntax.trivial) +in (let _160_1080 = (let _160_1070 = (sub (([]), (ed.FStar_Syntax_Syntax.repr))) +in (Prims.snd _160_1070)) +in (let _160_1079 = (sub ed.FStar_Syntax_Syntax.return_repr) +in (let _160_1078 = (sub ed.FStar_Syntax_Syntax.bind_repr) +in (let _160_1077 = (FStar_List.map (fun action -> (let _160_1076 = (FStar_Parser_Env.qualify env action.FStar_Syntax_Syntax.action_unqualified_name) +in (let _160_1075 = (let _160_1072 = (sub (([]), (action.FStar_Syntax_Syntax.action_defn))) +in (Prims.snd _160_1072)) +in (let _160_1074 = (let _160_1073 = (sub (([]), (action.FStar_Syntax_Syntax.action_typ))) +in (Prims.snd _160_1073)) +in {FStar_Syntax_Syntax.action_name = _160_1076; FStar_Syntax_Syntax.action_unqualified_name = action.FStar_Syntax_Syntax.action_unqualified_name; FStar_Syntax_Syntax.action_univs = action.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _160_1075; FStar_Syntax_Syntax.action_typ = _160_1074})))) ed.FStar_Syntax_Syntax.actions) +in {FStar_Syntax_Syntax.qualifiers = _160_1092; FStar_Syntax_Syntax.mname = mname; FStar_Syntax_Syntax.univs = []; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = _160_1091; FStar_Syntax_Syntax.ret_wp = _160_1090; FStar_Syntax_Syntax.bind_wp = _160_1089; FStar_Syntax_Syntax.if_then_else = _160_1088; FStar_Syntax_Syntax.ite_wp = _160_1087; FStar_Syntax_Syntax.stronger = _160_1086; FStar_Syntax_Syntax.close_wp = _160_1085; FStar_Syntax_Syntax.assert_p = _160_1084; FStar_Syntax_Syntax.assume_p = _160_1083; FStar_Syntax_Syntax.null_wp = _160_1082; FStar_Syntax_Syntax.trivial = _160_1081; FStar_Syntax_Syntax.repr = _160_1080; FStar_Syntax_Syntax.return_repr = _160_1079; FStar_Syntax_Syntax.bind_repr = _160_1078; FStar_Syntax_Syntax.actions = _160_1077})))))))))))))))) in ( let se = (build_sigelt ed d.FStar_Parser_AST.drange) @@ -3768,8 +3782,8 @@ in ( let env = (FStar_Parser_Env.push_sigelt env0 se) in ( -let env = (FStar_All.pipe_right ed.FStar_Syntax_Syntax.actions (FStar_List.fold_left (fun env a -> (let _160_1062 = (FStar_Syntax_Util.action_as_lb a) -in (FStar_Parser_Env.push_sigelt env _160_1062))) env)) +let env = (FStar_All.pipe_right ed.FStar_Syntax_Syntax.actions (FStar_List.fold_left (fun env a -> (let _160_1095 = (FStar_Syntax_Util.action_as_lb a) +in (FStar_Parser_Env.push_sigelt env _160_1095))) env)) in ( let env = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Parser_AST.Reflectable)) then begin @@ -3778,12 +3792,12 @@ let env = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Parser_AST.R let reflect_lid = (FStar_All.pipe_right (FStar_Ident.id_of_text "reflect") (FStar_Parser_Env.qualify monad_env)) in ( -let refl_decl = FStar_Syntax_Syntax.Sig_declare_typ (((reflect_lid), ([]), (FStar_Syntax_Syntax.tun), ((FStar_Syntax_Syntax.Assumption)::(FStar_Syntax_Syntax.Reflectable)::[]), (d.FStar_Parser_AST.drange))) +let refl_decl = FStar_Syntax_Syntax.Sig_declare_typ (((reflect_lid), ([]), (FStar_Syntax_Syntax.tun), ((FStar_Syntax_Syntax.Assumption)::(FStar_Syntax_Syntax.Reflectable (mname))::[]), (d.FStar_Parser_AST.drange))) in (FStar_Parser_Env.push_sigelt env refl_decl))) end else begin env end -in ((env), ((se)::[])))))))))) +in ((env), ((se)::[]))))))))))) end)) end))))) and desugar_decl : env_t -> FStar_Parser_AST.decl -> (env_t * FStar_Syntax_Syntax.sigelts) = (fun env d -> ( @@ -3796,7 +3810,7 @@ in (match (d.FStar_Parser_AST.d) with let se = FStar_Syntax_Syntax.Sig_pragma ((((trans_pragma p)), (d.FStar_Parser_AST.drange))) in ((env), ((se)::[]))) end -| FStar_Parser_AST.Fsdoc (_65_2714) -> begin +| FStar_Parser_AST.Fsdoc (_65_2720) -> begin ((env), ([])) end | FStar_Parser_AST.TopLevelModule (id) -> begin @@ -3809,46 +3823,46 @@ let env = (FStar_Parser_Env.push_namespace env lid) in ((env), ([]))) end | FStar_Parser_AST.ModuleAbbrev (x, l) -> begin -(let _160_1066 = (FStar_Parser_Env.push_module_abbrev env x l) -in ((_160_1066), ([]))) +(let _160_1100 = (FStar_Parser_Env.push_module_abbrev env x l) +in ((_160_1100), ([]))) end | FStar_Parser_AST.Tycon (qual, tcs) -> begin ( -let tcs = (FStar_List.map (fun _65_2732 -> (match (_65_2732) with -| (x, _65_2731) -> begin +let tcs = (FStar_List.map (fun _65_2738 -> (match (_65_2738) with +| (x, _65_2737) -> begin x end)) tcs) -in (let _160_1068 = (FStar_List.map trans_qual qual) -in (desugar_tycon env d.FStar_Parser_AST.drange _160_1068 tcs))) +in (let _160_1102 = (FStar_List.map (trans_qual None) qual) +in (desugar_tycon env d.FStar_Parser_AST.drange _160_1102 tcs))) end | FStar_Parser_AST.TopLevelLet (quals, isrec, lets) -> begin -(match ((let _160_1070 = (let _160_1069 = (desugar_term_maybe_top true env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((isrec), (lets), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Const (FStar_Const.Const_unit)) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr))))) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr)) -in (FStar_All.pipe_left FStar_Syntax_Subst.compress _160_1069)) -in _160_1070.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_let (lbs, _65_2741) -> begin +(match ((let _160_1104 = (let _160_1103 = (desugar_term_maybe_top true env (FStar_Parser_AST.mk_term (FStar_Parser_AST.Let (((isrec), (lets), ((FStar_Parser_AST.mk_term (FStar_Parser_AST.Const (FStar_Const.Const_unit)) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr))))) d.FStar_Parser_AST.drange FStar_Parser_AST.Expr)) +in (FStar_All.pipe_left FStar_Syntax_Subst.compress _160_1103)) +in _160_1104.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_let (lbs, _65_2747) -> begin ( let fvs = (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.map (fun lb -> (FStar_Util.right lb.FStar_Syntax_Syntax.lbname)))) in ( let quals = (match (quals) with -| (_65_2749)::_65_2747 -> begin -(FStar_List.map trans_qual quals) +| (_65_2755)::_65_2753 -> begin +(FStar_List.map (trans_qual None) quals) end -| _65_2752 -> begin +| _65_2758 -> begin (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.collect (fun _65_25 -> (match (_65_25) with -| {FStar_Syntax_Syntax.lbname = FStar_Util.Inl (_65_2763); FStar_Syntax_Syntax.lbunivs = _65_2761; FStar_Syntax_Syntax.lbtyp = _65_2759; FStar_Syntax_Syntax.lbeff = _65_2757; FStar_Syntax_Syntax.lbdef = _65_2755} -> begin +| {FStar_Syntax_Syntax.lbname = FStar_Util.Inl (_65_2769); FStar_Syntax_Syntax.lbunivs = _65_2767; FStar_Syntax_Syntax.lbtyp = _65_2765; FStar_Syntax_Syntax.lbeff = _65_2763; FStar_Syntax_Syntax.lbdef = _65_2761} -> begin [] end -| {FStar_Syntax_Syntax.lbname = FStar_Util.Inr (fv); FStar_Syntax_Syntax.lbunivs = _65_2773; FStar_Syntax_Syntax.lbtyp = _65_2771; FStar_Syntax_Syntax.lbeff = _65_2769; FStar_Syntax_Syntax.lbdef = _65_2767} -> begin +| {FStar_Syntax_Syntax.lbname = FStar_Util.Inr (fv); FStar_Syntax_Syntax.lbunivs = _65_2779; FStar_Syntax_Syntax.lbtyp = _65_2777; FStar_Syntax_Syntax.lbeff = _65_2775; FStar_Syntax_Syntax.lbdef = _65_2773} -> begin (FStar_Parser_Env.lookup_letbinding_quals env fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) end)))) end) in ( -let quals = if (FStar_All.pipe_right lets (FStar_Util.for_some (fun _65_2781 -> (match (_65_2781) with -| (_65_2779, t) -> begin +let quals = if (FStar_All.pipe_right lets (FStar_Util.for_some (fun _65_2787 -> (match (_65_2787) with +| (_65_2785, t) -> begin (t.FStar_Parser_AST.level = FStar_Parser_AST.Formula) end)))) then begin (FStar_Syntax_Syntax.Logic)::quals @@ -3858,31 +3872,31 @@ end in ( let lbs = if (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Abstract)) then begin -(let _160_1075 = (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.map (fun lb -> ( +(let _160_1109 = (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.map (fun lb -> ( let fv = (FStar_Util.right lb.FStar_Syntax_Syntax.lbname) in ( -let _65_2785 = lb +let _65_2791 = lb in {FStar_Syntax_Syntax.lbname = FStar_Util.Inr (( -let _65_2787 = fv -in {FStar_Syntax_Syntax.fv_name = _65_2787.FStar_Syntax_Syntax.fv_name; FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_abstract (fv.FStar_Syntax_Syntax.fv_delta); FStar_Syntax_Syntax.fv_qual = _65_2787.FStar_Syntax_Syntax.fv_qual})); FStar_Syntax_Syntax.lbunivs = _65_2785.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _65_2785.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _65_2785.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = _65_2785.FStar_Syntax_Syntax.lbdef}))))) -in (((Prims.fst lbs)), (_160_1075))) +let _65_2793 = fv +in {FStar_Syntax_Syntax.fv_name = _65_2793.FStar_Syntax_Syntax.fv_name; FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_abstract (fv.FStar_Syntax_Syntax.fv_delta); FStar_Syntax_Syntax.fv_qual = _65_2793.FStar_Syntax_Syntax.fv_qual})); FStar_Syntax_Syntax.lbunivs = _65_2791.FStar_Syntax_Syntax.lbunivs; FStar_Syntax_Syntax.lbtyp = _65_2791.FStar_Syntax_Syntax.lbtyp; FStar_Syntax_Syntax.lbeff = _65_2791.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = _65_2791.FStar_Syntax_Syntax.lbdef}))))) +in (((Prims.fst lbs)), (_160_1109))) end else begin lbs end in ( -let s = (let _160_1078 = (let _160_1077 = (FStar_All.pipe_right fvs (FStar_List.map (fun fv -> fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v))) -in ((lbs), (d.FStar_Parser_AST.drange), (_160_1077), (quals))) -in FStar_Syntax_Syntax.Sig_let (_160_1078)) +let s = (let _160_1112 = (let _160_1111 = (FStar_All.pipe_right fvs (FStar_List.map (fun fv -> fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v))) +in ((lbs), (d.FStar_Parser_AST.drange), (_160_1111), (quals))) +in FStar_Syntax_Syntax.Sig_let (_160_1112)) in ( let env = (FStar_Parser_Env.push_sigelt env s) in ((env), ((s)::[])))))))) end -| _65_2794 -> begin +| _65_2800 -> begin (FStar_All.failwith "Desugaring a let did not produce a let") end) end @@ -3899,17 +3913,17 @@ end ( let f = (desugar_formula env t) -in (let _160_1082 = (let _160_1081 = (let _160_1080 = (let _160_1079 = (FStar_Parser_Env.qualify env id) -in ((_160_1079), (f), ((FStar_Syntax_Syntax.Assumption)::[]), (d.FStar_Parser_AST.drange))) -in FStar_Syntax_Syntax.Sig_assume (_160_1080)) -in (_160_1081)::[]) -in ((env), (_160_1082)))) +in (let _160_1116 = (let _160_1115 = (let _160_1114 = (let _160_1113 = (FStar_Parser_Env.qualify env id) +in ((_160_1113), (f), ((FStar_Syntax_Syntax.Assumption)::[]), (d.FStar_Parser_AST.drange))) +in FStar_Syntax_Syntax.Sig_assume (_160_1114)) +in (_160_1115)::[]) +in ((env), (_160_1116)))) end | FStar_Parser_AST.Val (quals, id, t) -> begin ( -let t = (let _160_1083 = (close_fun env t) -in (desugar_term env _160_1083)) +let t = (let _160_1117 = (close_fun env t) +in (desugar_term env _160_1117)) in ( let quals = if (env.FStar_Parser_Env.iface && env.FStar_Parser_Env.admitted_iface) then begin @@ -3919,10 +3933,10 @@ quals end in ( -let se = (let _160_1086 = (let _160_1085 = (FStar_Parser_Env.qualify env id) -in (let _160_1084 = (FStar_List.map trans_qual quals) -in ((_160_1085), ([]), (t), (_160_1084), (d.FStar_Parser_AST.drange)))) -in FStar_Syntax_Syntax.Sig_declare_typ (_160_1086)) +let se = (let _160_1120 = (let _160_1119 = (FStar_Parser_Env.qualify env id) +in (let _160_1118 = (FStar_List.map (trans_qual None) quals) +in ((_160_1119), ([]), (t), (_160_1118), (d.FStar_Parser_AST.drange)))) +in FStar_Syntax_Syntax.Sig_declare_typ (_160_1120)) in ( let env = (FStar_Parser_Env.push_sigelt env se) @@ -3931,9 +3945,9 @@ end | FStar_Parser_AST.Exception (id, None) -> begin ( -let _65_2821 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) FStar_Syntax_Const.exn_lid) -in (match (_65_2821) with -| (t, _65_2820) -> begin +let _65_2827 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) FStar_Syntax_Const.exn_lid) +in (match (_65_2827) with +| (t, _65_2826) -> begin ( let l = (FStar_Parser_Env.qualify env id) @@ -3964,12 +3978,12 @@ end let t = (desugar_term env term) in ( -let t = (let _160_1091 = (let _160_1087 = (FStar_Syntax_Syntax.null_binder t) -in (_160_1087)::[]) -in (let _160_1090 = (let _160_1089 = (let _160_1088 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) FStar_Syntax_Const.exn_lid) -in (Prims.fst _160_1088)) -in (FStar_All.pipe_left FStar_Syntax_Syntax.mk_Total _160_1089)) -in (FStar_Syntax_Util.arrow _160_1091 _160_1090))) +let t = (let _160_1125 = (let _160_1121 = (FStar_Syntax_Syntax.null_binder t) +in (_160_1121)::[]) +in (let _160_1124 = (let _160_1123 = (let _160_1122 = (FStar_Parser_Env.fail_or env (FStar_Parser_Env.try_lookup_lid env) FStar_Syntax_Const.exn_lid) +in (Prims.fst _160_1122)) +in (FStar_All.pipe_left FStar_Syntax_Syntax.mk_Total _160_1123)) +in (FStar_Syntax_Util.arrow _160_1125 _160_1124))) in ( let l = (FStar_Parser_Env.qualify env id) @@ -3996,8 +4010,8 @@ end | FStar_Parser_AST.KindAbbrev (id, binders, k) -> begin ( -let _65_2850 = (desugar_binders env binders) -in (match (_65_2850) with +let _65_2856 = (desugar_binders env binders) +in (match (_65_2856) with | (env_k, binders) -> begin ( @@ -4031,12 +4045,12 @@ end let lookup = (fun l -> (match ((FStar_Parser_Env.try_lookup_effect_name env l)) with | None -> begin -(let _160_1102 = (let _160_1101 = (let _160_1100 = (let _160_1099 = (let _160_1098 = (FStar_Syntax_Print.lid_to_string l) -in (Prims.strcat _160_1098 " not found")) -in (Prims.strcat "Effect name " _160_1099)) -in ((_160_1100), (d.FStar_Parser_AST.drange))) -in FStar_Syntax_Syntax.Error (_160_1101)) -in (Prims.raise _160_1102)) +(let _160_1136 = (let _160_1135 = (let _160_1134 = (let _160_1133 = (let _160_1132 = (FStar_Syntax_Print.lid_to_string l) +in (Prims.strcat _160_1132 " not found")) +in (Prims.strcat "Effect name " _160_1133)) +in ((_160_1134), (d.FStar_Parser_AST.drange))) +in FStar_Syntax_Syntax.Error (_160_1135)) +in (Prims.raise _160_1136)) end | Some (l) -> begin l @@ -4049,29 +4063,29 @@ in ( let dst = (lookup l.FStar_Parser_AST.mdest) in ( -let _65_2914 = (match (l.FStar_Parser_AST.lift_op) with +let _65_2920 = (match (l.FStar_Parser_AST.lift_op) with | FStar_Parser_AST.NonReifiableLift (t) -> begin -(let _160_1105 = (let _160_1104 = (let _160_1103 = (desugar_term env t) -in (([]), (_160_1103))) -in Some (_160_1104)) -in ((_160_1105), (None))) +(let _160_1139 = (let _160_1138 = (let _160_1137 = (desugar_term env t) +in (([]), (_160_1137))) +in Some (_160_1138)) +in ((_160_1139), (None))) end | FStar_Parser_AST.ReifiableLift (wp, t) -> begin -(let _160_1111 = (let _160_1107 = (let _160_1106 = (desugar_term env wp) -in (([]), (_160_1106))) -in Some (_160_1107)) -in (let _160_1110 = (let _160_1109 = (let _160_1108 = (desugar_term env t) -in (([]), (_160_1108))) -in Some (_160_1109)) -in ((_160_1111), (_160_1110)))) +(let _160_1145 = (let _160_1141 = (let _160_1140 = (desugar_term env wp) +in (([]), (_160_1140))) +in Some (_160_1141)) +in (let _160_1144 = (let _160_1143 = (let _160_1142 = (desugar_term env t) +in (([]), (_160_1142))) +in Some (_160_1143)) +in ((_160_1145), (_160_1144)))) end | FStar_Parser_AST.LiftForFree (t) -> begin -(let _160_1114 = (let _160_1113 = (let _160_1112 = (desugar_term env t) -in (([]), (_160_1112))) -in Some (_160_1113)) -in ((None), (_160_1114))) +(let _160_1148 = (let _160_1147 = (let _160_1146 = (desugar_term env t) +in (([]), (_160_1146))) +in Some (_160_1147)) +in ((None), (_160_1148))) end) -in (match (_65_2914) with +in (match (_65_2920) with | (lift_wp, lift) -> begin ( @@ -4081,12 +4095,12 @@ end))))) end))) -let desugar_decls : FStar_Parser_Env.env -> FStar_Parser_AST.decl Prims.list -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.sigelts) = (fun env decls -> (FStar_List.fold_left (fun _65_2920 d -> (match (_65_2920) with +let desugar_decls : FStar_Parser_Env.env -> FStar_Parser_AST.decl Prims.list -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.sigelts) = (fun env decls -> (FStar_List.fold_left (fun _65_2926 d -> (match (_65_2926) with | (env, sigelts) -> begin ( -let _65_2924 = (desugar_decl env d) -in (match (_65_2924) with +let _65_2930 = (desugar_decl env d) +in (match (_65_2930) with | (env, se) -> begin ((env), ((FStar_List.append sigelts se))) end)) @@ -4107,21 +4121,21 @@ end end) in ( -let _65_2947 = (match (m) with +let _65_2953 = (match (m) with | FStar_Parser_AST.Interface (mname, decls, admitted) -> begin -(let _160_1132 = (FStar_Parser_Env.prepare_module_or_interface true admitted env mname) -in ((_160_1132), (mname), (decls), (true))) +(let _160_1166 = (FStar_Parser_Env.prepare_module_or_interface true admitted env mname) +in ((_160_1166), (mname), (decls), (true))) end | FStar_Parser_AST.Module (mname, decls) -> begin -(let _160_1133 = (FStar_Parser_Env.prepare_module_or_interface false false env mname) -in ((_160_1133), (mname), (decls), (false))) +(let _160_1167 = (FStar_Parser_Env.prepare_module_or_interface false false env mname) +in ((_160_1167), (mname), (decls), (false))) end) -in (match (_65_2947) with +in (match (_65_2953) with | ((env, pop_when_done), mname, decls, intf) -> begin ( -let _65_2950 = (desugar_decls env decls) -in (match (_65_2950) with +let _65_2956 = (desugar_decls env decls) +in (match (_65_2956) with | (env, sigelts) -> begin ( @@ -4138,7 +4152,7 @@ let m = if (FStar_Options.interactive_fsi ()) then begin | FStar_Parser_AST.Module (mname, decls) -> begin FStar_Parser_AST.Interface (((mname), (decls), (true))) end -| FStar_Parser_AST.Interface (mname, _65_2961, _65_2963) -> begin +| FStar_Parser_AST.Interface (mname, _65_2967, _65_2969) -> begin (FStar_All.failwith (Prims.strcat "Impossible: " mname.FStar_Ident.ident.FStar_Ident.idText)) end) end else begin @@ -4146,51 +4160,51 @@ m end in ( -let _65_2971 = (desugar_modul_common curmod env m) -in (match (_65_2971) with -| (x, y, _65_2970) -> begin +let _65_2977 = (desugar_modul_common curmod env m) +in (match (_65_2977) with +| (x, y, _65_2976) -> begin ((x), (y)) end)))) let desugar_modul : FStar_Parser_Env.env -> FStar_Parser_AST.modul -> (env_t * FStar_Syntax_Syntax.modul) = (fun env m -> ( -let _65_2977 = (desugar_modul_common None env m) -in (match (_65_2977) with +let _65_2983 = (desugar_modul_common None env m) +in (match (_65_2983) with | (env, modul, pop_when_done) -> begin ( let env = (FStar_Parser_Env.finish_module_or_interface env modul) in ( -let _65_2979 = if (FStar_Options.dump_module modul.FStar_Syntax_Syntax.name.FStar_Ident.str) then begin -(let _160_1144 = (FStar_Syntax_Print.modul_to_string modul) -in (FStar_Util.print1 "%s\n" _160_1144)) +let _65_2985 = if (FStar_Options.dump_module modul.FStar_Syntax_Syntax.name.FStar_Ident.str) then begin +(let _160_1178 = (FStar_Syntax_Print.modul_to_string modul) +in (FStar_Util.print1 "%s\n" _160_1178)) end else begin () end -in (let _160_1145 = if pop_when_done then begin +in (let _160_1179 = if pop_when_done then begin (FStar_Parser_Env.export_interface modul.FStar_Syntax_Syntax.name env) end else begin env end -in ((_160_1145), (modul))))) +in ((_160_1179), (modul))))) end))) let desugar_file : FStar_Parser_Env.env -> FStar_Parser_AST.file -> (FStar_Parser_Env.env * FStar_Syntax_Syntax.modul Prims.list) = (fun env f -> ( -let _65_2992 = (FStar_List.fold_left (fun _65_2985 m -> (match (_65_2985) with +let _65_2998 = (FStar_List.fold_left (fun _65_2991 m -> (match (_65_2991) with | (env, mods) -> begin ( -let _65_2989 = (desugar_modul env m) -in (match (_65_2989) with +let _65_2995 = (desugar_modul env m) +in (match (_65_2995) with | (env, m) -> begin ((env), ((m)::mods)) end)) end)) ((env), ([])) f) -in (match (_65_2992) with +in (match (_65_2998) with | (env, mods) -> begin ((env), ((FStar_List.rev mods))) end))) @@ -4198,15 +4212,15 @@ end))) let add_modul_to_env : FStar_Syntax_Syntax.modul -> FStar_Parser_Env.env -> FStar_Parser_Env.env = (fun m en -> ( -let _65_2997 = (FStar_Parser_Env.prepare_module_or_interface false false en m.FStar_Syntax_Syntax.name) -in (match (_65_2997) with +let _65_3003 = (FStar_Parser_Env.prepare_module_or_interface false false en m.FStar_Syntax_Syntax.name) +in (match (_65_3003) with | (en, pop_when_done) -> begin ( let en = (FStar_List.fold_left FStar_Parser_Env.push_sigelt ( -let _65_2998 = en -in {FStar_Parser_Env.curmodule = Some (m.FStar_Syntax_Syntax.name); FStar_Parser_Env.modules = _65_2998.FStar_Parser_Env.modules; FStar_Parser_Env.open_namespaces = _65_2998.FStar_Parser_Env.open_namespaces; FStar_Parser_Env.modul_abbrevs = _65_2998.FStar_Parser_Env.modul_abbrevs; FStar_Parser_Env.sigaccum = _65_2998.FStar_Parser_Env.sigaccum; FStar_Parser_Env.localbindings = _65_2998.FStar_Parser_Env.localbindings; FStar_Parser_Env.recbindings = _65_2998.FStar_Parser_Env.recbindings; FStar_Parser_Env.sigmap = _65_2998.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_2998.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_2998.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_2998.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = _65_2998.FStar_Parser_Env.expect_typ}) m.FStar_Syntax_Syntax.exports) +let _65_3004 = en +in {FStar_Parser_Env.curmodule = Some (m.FStar_Syntax_Syntax.name); FStar_Parser_Env.curmonad = _65_3004.FStar_Parser_Env.curmonad; FStar_Parser_Env.modules = _65_3004.FStar_Parser_Env.modules; FStar_Parser_Env.scope_mods = _65_3004.FStar_Parser_Env.scope_mods; FStar_Parser_Env.sigaccum = _65_3004.FStar_Parser_Env.sigaccum; FStar_Parser_Env.sigmap = _65_3004.FStar_Parser_Env.sigmap; FStar_Parser_Env.default_result_effect = _65_3004.FStar_Parser_Env.default_result_effect; FStar_Parser_Env.iface = _65_3004.FStar_Parser_Env.iface; FStar_Parser_Env.admitted_iface = _65_3004.FStar_Parser_Env.admitted_iface; FStar_Parser_Env.expect_typ = _65_3004.FStar_Parser_Env.expect_typ}) m.FStar_Syntax_Syntax.exports) in ( let env = (FStar_Parser_Env.finish_module_or_interface en m) diff --git a/src/ocaml-output/FStar_Syntax_Print.ml b/src/ocaml-output/FStar_Syntax_Print.ml index 5cb350b6f58..75a7b6a9b4f 100755 --- a/src/ocaml-output/FStar_Syntax_Print.ml +++ b/src/ocaml-output/FStar_Syntax_Print.ml @@ -388,8 +388,8 @@ end | FStar_Syntax_Syntax.Reifiable -> begin "reify" end -| FStar_Syntax_Syntax.Reflectable -> begin -"reflect" +| FStar_Syntax_Syntax.Reflectable (l) -> begin +(FStar_Util.format1 "(reflect %s)" l.FStar_Ident.str) end)) @@ -397,7 +397,7 @@ let quals_to_string : FStar_Syntax_Syntax.qualifier Prims.list -> Prims.string | [] -> begin "" end -| _39_212 -> begin +| _39_213 -> begin (let _134_101 = (FStar_All.pipe_right quals (FStar_List.map qual_to_string)) in (FStar_All.pipe_right _134_101 (FStar_String.concat " "))) end)) @@ -407,7 +407,7 @@ let quals_to_string' : FStar_Syntax_Syntax.qualifier Prims.list -> Prims.strin | [] -> begin "" end -| _39_216 -> begin +| _39_217 -> begin (let _134_104 = (quals_to_string quals) in (Prims.strcat _134_104 " ")) end)) @@ -417,17 +417,17 @@ let rec term_to_string : FStar_Syntax_Syntax.term -> Prims.string = (fun x -> let x = (FStar_Syntax_Subst.compress x) in (match (x.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_delayed (_39_220) -> begin +| FStar_Syntax_Syntax.Tm_delayed (_39_221) -> begin (FStar_All.failwith "impossible") end -| FStar_Syntax_Syntax.Tm_app (_39_223, []) -> begin +| FStar_Syntax_Syntax.Tm_app (_39_224, []) -> begin (FStar_All.failwith "Empty args!") end | FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_pattern (ps)) -> begin ( -let pats = (let _134_129 = (FStar_All.pipe_right ps (FStar_List.map (fun args -> (let _134_128 = (FStar_All.pipe_right args (FStar_List.map (fun _39_236 -> (match (_39_236) with -| (t, _39_235) -> begin +let pats = (let _134_129 = (FStar_All.pipe_right ps (FStar_List.map (fun args -> (let _134_128 = (FStar_All.pipe_right args (FStar_List.map (fun _39_237 -> (match (_39_237) with +| (t, _39_236) -> begin (term_to_string t) end)))) in (FStar_All.pipe_right _134_128 (FStar_String.concat "; ")))))) @@ -454,7 +454,7 @@ end in (let _134_139 = (term_to_string t) in (FStar_Util.format3 "Meta_labeled(%s, %s){%s}" l _134_140 _134_139))) end -| FStar_Syntax_Syntax.Tm_meta (t, _39_262) -> begin +| FStar_Syntax_Syntax.Tm_meta (t, _39_263) -> begin (term_to_string t) end | FStar_Syntax_Syntax.Tm_bvar (x) -> begin @@ -466,7 +466,7 @@ end | FStar_Syntax_Syntax.Tm_fvar (f) -> begin (fv_to_string f) end -| FStar_Syntax_Syntax.Tm_uvar (u, _39_273) -> begin +| FStar_Syntax_Syntax.Tm_uvar (u, _39_274) -> begin (uvar_to_string u) end | FStar_Syntax_Syntax.Tm_constant (c) -> begin @@ -499,7 +499,7 @@ end in (let _134_148 = (term_to_string t2) in (FStar_Util.format3 "(fun %s -> (%s $$ (name only) %s))" _134_149 _134_148 l.FStar_Ident.str))) end -| _39_296 -> begin +| _39_297 -> begin (let _134_151 = (binders_to_string " " bs) in (let _134_150 = (term_to_string t2) in (FStar_Util.format2 "(fun %s -> %s)" _134_151 _134_150))) @@ -521,19 +521,19 @@ end in (let _134_157 = (term_to_string e) in (FStar_Util.format2 "%s\nin\n%s" _134_158 _134_157))) end -| FStar_Syntax_Syntax.Tm_ascribed (e, FStar_Util.Inl (t), _39_313) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (e, FStar_Util.Inl (t), _39_314) -> begin (let _134_160 = (term_to_string e) in (let _134_159 = (term_to_string t) in (FStar_Util.format2 "(%s <: %s)" _134_160 _134_159))) end -| FStar_Syntax_Syntax.Tm_ascribed (e, FStar_Util.Inr (c), _39_320) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (e, FStar_Util.Inr (c), _39_321) -> begin (let _134_162 = (term_to_string e) in (let _134_161 = (comp_to_string c) in (FStar_Util.format2 "(%s <: %s)" _134_162 _134_161))) end | FStar_Syntax_Syntax.Tm_match (head, branches) -> begin (let _134_170 = (term_to_string head) -in (let _134_169 = (let _134_168 = (FStar_All.pipe_right branches (FStar_List.map (fun _39_330 -> (match (_39_330) with +in (let _134_169 = (let _134_168 = (FStar_All.pipe_right branches (FStar_List.map (fun _39_331 -> (match (_39_331) with | (p, wopt, e) -> begin (let _134_167 = (FStar_All.pipe_right p pat_to_string) in (let _134_166 = (match (wopt) with @@ -559,13 +559,13 @@ end else begin (term_to_string t) end end -| _39_339 -> begin +| _39_340 -> begin (tag_of_term x) end))) and pat_to_string : FStar_Syntax_Syntax.pat -> Prims.string = (fun x -> (match (x.FStar_Syntax_Syntax.v) with | FStar_Syntax_Syntax.Pat_cons (l, pats) -> begin (let _134_177 = (fv_to_string l) -in (let _134_176 = (let _134_175 = (FStar_List.map (fun _39_347 -> (match (_39_347) with +in (let _134_176 = (let _134_175 = (FStar_List.map (fun _39_348 -> (match (_39_348) with | (x, b) -> begin ( @@ -579,7 +579,7 @@ end)) pats) in (FStar_All.pipe_right _134_175 (FStar_String.concat " "))) in (FStar_Util.format2 "(%s %s)" _134_177 _134_176))) end -| FStar_Syntax_Syntax.Pat_dot_term (x, _39_351) -> begin +| FStar_Syntax_Syntax.Pat_dot_term (x, _39_352) -> begin if (FStar_Options.print_bound_var_types ()) then begin (let _134_179 = (bv_to_string x) in (let _134_178 = (term_to_string x.FStar_Syntax_Syntax.sort) @@ -618,26 +618,26 @@ and lbs_to_string : FStar_Syntax_Syntax.qualifier Prims.list -> FStar_Syntax_S let lbs = if (FStar_Options.print_universes ()) then begin (let _134_190 = (FStar_All.pipe_right (Prims.snd lbs) (FStar_List.map (fun lb -> ( -let _39_367 = (let _134_188 = (FStar_Syntax_Util.mk_conj lb.FStar_Syntax_Syntax.lbtyp lb.FStar_Syntax_Syntax.lbdef) +let _39_368 = (let _134_188 = (FStar_Syntax_Util.mk_conj lb.FStar_Syntax_Syntax.lbtyp lb.FStar_Syntax_Syntax.lbdef) in (FStar_Syntax_Subst.open_univ_vars lb.FStar_Syntax_Syntax.lbunivs _134_188)) -in (match (_39_367) with +in (match (_39_368) with | (us, td) -> begin ( -let _39_385 = (match ((let _134_189 = (FStar_Syntax_Subst.compress td) +let _39_386 = (match ((let _134_189 = (FStar_Syntax_Subst.compress td) in _134_189.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_app (_39_369, ((t, _39_376))::((d, _39_372))::[]) -> begin +| FStar_Syntax_Syntax.Tm_app (_39_370, ((t, _39_377))::((d, _39_373))::[]) -> begin ((t), (d)) end -| _39_382 -> begin +| _39_383 -> begin (FStar_All.failwith "Impossibe") end) -in (match (_39_385) with +in (match (_39_386) with | (t, d) -> begin ( -let _39_386 = lb -in {FStar_Syntax_Syntax.lbname = _39_386.FStar_Syntax_Syntax.lbname; FStar_Syntax_Syntax.lbunivs = us; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _39_386.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = d}) +let _39_387 = lb +in {FStar_Syntax_Syntax.lbname = _39_387.FStar_Syntax_Syntax.lbname; FStar_Syntax_Syntax.lbunivs = us; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _39_387.FStar_Syntax_Syntax.lbeff; FStar_Syntax_Syntax.lbdef = d}) end)) end))))) in (((Prims.fst lbs)), (_134_190))) @@ -680,13 +680,13 @@ end | Some (FStar_Syntax_Syntax.Equality) -> begin (Prims.strcat "$" s) end -| _39_402 -> begin +| _39_403 -> begin s end)) and binder_to_string' : Prims.bool -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) -> Prims.string = (fun is_arrow b -> ( -let _39_407 = b -in (match (_39_407) with +let _39_408 = b +in (match (_39_408) with | (a, imp) -> begin if (FStar_Syntax_Syntax.is_null_binder b) then begin (let _134_209 = (term_to_string a.FStar_Syntax_Syntax.sort) @@ -735,24 +735,24 @@ end in (let _134_224 = (FStar_All.pipe_right args (FStar_List.map arg_to_string)) in (FStar_All.pipe_right _134_224 (FStar_String.concat " "))))) and comp_to_string : FStar_Syntax_Syntax.comp -> Prims.string = (fun c -> (match (c.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (t, _39_422) -> begin +| FStar_Syntax_Syntax.Total (t, _39_423) -> begin (match ((let _134_226 = (FStar_Syntax_Subst.compress t) in _134_226.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_type (_39_426) when (not ((FStar_Options.print_implicits ()))) -> begin +| FStar_Syntax_Syntax.Tm_type (_39_427) when (not ((FStar_Options.print_implicits ()))) -> begin (term_to_string t) end -| _39_429 -> begin +| _39_430 -> begin (let _134_227 = (term_to_string t) in (FStar_Util.format1 "Tot %s" _134_227)) end) end -| FStar_Syntax_Syntax.GTotal (t, _39_432) -> begin +| FStar_Syntax_Syntax.GTotal (t, _39_433) -> begin (match ((let _134_228 = (FStar_Syntax_Subst.compress t) in _134_228.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_type (_39_436) when (not ((FStar_Options.print_implicits ()))) -> begin +| FStar_Syntax_Syntax.Tm_type (_39_437) when (not ((FStar_Options.print_implicits ()))) -> begin (term_to_string t) end -| _39_439 -> begin +| _39_440 -> begin (let _134_229 = (term_to_string t) in (FStar_Util.format1 "GTot %s" _134_229)) end) @@ -764,7 +764,7 @@ let basic = if ((FStar_All.pipe_right c.FStar_Syntax_Syntax.flags (FStar_Util.fo | FStar_Syntax_Syntax.TOTAL -> begin true end -| _39_445 -> begin +| _39_446 -> begin false end)))) && (not ((FStar_Options.print_effect_args ())))) then begin (let _134_231 = (term_to_string c.FStar_Syntax_Syntax.result_typ) @@ -777,7 +777,7 @@ if ((not ((FStar_Options.print_effect_args ()))) && (FStar_All.pipe_right c.FSta | FStar_Syntax_Syntax.MLEFFECT -> begin true end -| _39_449 -> begin +| _39_450 -> begin false end))))) then begin (let _134_233 = (term_to_string c.FStar_Syntax_Syntax.result_typ) @@ -805,7 +805,7 @@ let dec = (let _134_243 = (FStar_All.pipe_right c.FStar_Syntax_Syntax.flags (FSt in (FStar_Util.format1 " (decreases %s)" _134_241)) in (_134_242)::[]) end -| _39_455 -> begin +| _39_456 -> begin [] end)))) in (FStar_All.pipe_right _134_243 (FStar_String.concat " "))) @@ -821,7 +821,7 @@ end else begin end) -let tscheme_to_string : FStar_Syntax_Syntax.tscheme -> Prims.string = (fun _39_461 -> (match (_39_461) with +let tscheme_to_string : FStar_Syntax_Syntax.tscheme -> Prims.string = (fun _39_462 -> (match (_39_462) with | (us, t) -> begin (let _134_251 = (let _134_249 = (univ_names_to_string us) in (FStar_All.pipe_left enclose_universes _134_249)) @@ -885,27 +885,27 @@ in (FStar_Util.format "new_effect%s { %s%s %s : %s \n return_wp = %s\n; bind_ let rec sigelt_to_string : FStar_Syntax_Syntax.sigelt -> Prims.string = (fun x -> (match (x) with -| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.ResetOptions (None), _39_471) -> begin +| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.ResetOptions (None), _39_472) -> begin "#reset-options" end -| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.ResetOptions (Some (s)), _39_478) -> begin +| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.ResetOptions (Some (s)), _39_479) -> begin (FStar_Util.format1 "#reset-options \"%s\"" s) end -| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.SetOptions (s), _39_484) -> begin +| FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.SetOptions (s), _39_485) -> begin (FStar_Util.format1 "#set-options \"%s\"" s) end -| FStar_Syntax_Syntax.Sig_inductive_typ (lid, univs, tps, k, _39_492, _39_494, quals, _39_497) -> begin +| FStar_Syntax_Syntax.Sig_inductive_typ (lid, univs, tps, k, _39_493, _39_495, quals, _39_498) -> begin (let _134_307 = (quals_to_string' quals) in (let _134_306 = (binders_to_string " " tps) in (let _134_305 = (term_to_string k) in (FStar_Util.format4 "%stype %s %s : %s" _134_307 lid.FStar_Ident.str _134_306 _134_305)))) end -| FStar_Syntax_Syntax.Sig_datacon (lid, univs, t, _39_504, _39_506, _39_508, _39_510, _39_512) -> begin +| FStar_Syntax_Syntax.Sig_datacon (lid, univs, t, _39_505, _39_507, _39_509, _39_511, _39_513) -> begin if (FStar_Options.print_universes ()) then begin ( -let _39_517 = (FStar_Syntax_Subst.open_univ_vars univs t) -in (match (_39_517) with +let _39_518 = (FStar_Syntax_Subst.open_univ_vars univs t) +in (match (_39_518) with | (univs, t) -> begin (let _134_309 = (univ_names_to_string univs) in (let _134_308 = (term_to_string t) @@ -916,11 +916,11 @@ end else begin in (FStar_Util.format2 "datacon %s : %s" lid.FStar_Ident.str _134_310)) end end -| FStar_Syntax_Syntax.Sig_declare_typ (lid, univs, t, quals, _39_523) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (lid, univs, t, quals, _39_524) -> begin ( -let _39_528 = (FStar_Syntax_Subst.open_univ_vars univs t) -in (match (_39_528) with +let _39_529 = (FStar_Syntax_Subst.open_univ_vars univs t) +in (match (_39_529) with | (univs, t) -> begin (let _134_314 = (quals_to_string' quals) in (let _134_313 = if (FStar_Options.print_universes ()) then begin @@ -933,25 +933,25 @@ in (let _134_312 = (term_to_string t) in (FStar_Util.format4 "%sval %s %s : %s" _134_314 lid.FStar_Ident.str _134_313 _134_312)))) end)) end -| FStar_Syntax_Syntax.Sig_assume (lid, f, _39_532, _39_534) -> begin +| FStar_Syntax_Syntax.Sig_assume (lid, f, _39_533, _39_535) -> begin (let _134_315 = (term_to_string f) in (FStar_Util.format2 "val %s : %s" lid.FStar_Ident.str _134_315)) end -| FStar_Syntax_Syntax.Sig_let (lbs, _39_539, _39_541, qs) -> begin +| FStar_Syntax_Syntax.Sig_let (lbs, _39_540, _39_542, qs) -> begin (lbs_to_string qs lbs) end -| FStar_Syntax_Syntax.Sig_main (e, _39_547) -> begin +| FStar_Syntax_Syntax.Sig_main (e, _39_548) -> begin (let _134_316 = (term_to_string e) in (FStar_Util.format1 "let _ = %s" _134_316)) end -| FStar_Syntax_Syntax.Sig_bundle (ses, _39_552, _39_554, _39_556) -> begin +| FStar_Syntax_Syntax.Sig_bundle (ses, _39_553, _39_555, _39_557) -> begin (let _134_317 = (FStar_List.map sigelt_to_string ses) in (FStar_All.pipe_right _134_317 (FStar_String.concat "\n"))) end -| FStar_Syntax_Syntax.Sig_new_effect (ed, _39_561) -> begin +| FStar_Syntax_Syntax.Sig_new_effect (ed, _39_562) -> begin (eff_decl_to_string false ed) end -| FStar_Syntax_Syntax.Sig_new_effect_for_free (ed, _39_566) -> begin +| FStar_Syntax_Syntax.Sig_new_effect_for_free (ed, _39_567) -> begin (eff_decl_to_string true ed) end | FStar_Syntax_Syntax.Sig_sub_effect (se, r) -> begin @@ -961,16 +961,16 @@ let lift_wp = (match (((se.FStar_Syntax_Syntax.lift_wp), (se.FStar_Syntax_Syntax | (None, None) -> begin (FStar_All.failwith "impossible") end -| (Some (lift_wp), _39_579) -> begin +| (Some (lift_wp), _39_580) -> begin lift_wp end -| (_39_582, Some (lift)) -> begin +| (_39_583, Some (lift)) -> begin lift end) in ( -let _39_589 = (FStar_Syntax_Subst.open_univ_vars (Prims.fst lift_wp) (Prims.snd lift_wp)) -in (match (_39_589) with +let _39_590 = (FStar_Syntax_Subst.open_univ_vars (Prims.fst lift_wp) (Prims.snd lift_wp)) +in (match (_39_590) with | (us, t) -> begin (let _134_321 = (lid_to_string se.FStar_Syntax_Syntax.source) in (let _134_320 = (lid_to_string se.FStar_Syntax_Syntax.target) @@ -979,25 +979,25 @@ in (let _134_318 = (term_to_string t) in (FStar_Util.format4 "sub_effect %s ~> %s : <%s> %s" _134_321 _134_320 _134_319 _134_318))))) end))) end -| FStar_Syntax_Syntax.Sig_effect_abbrev (l, univs, tps, c, _39_595, _39_597) -> begin +| FStar_Syntax_Syntax.Sig_effect_abbrev (l, univs, tps, c, _39_596, _39_598) -> begin if (FStar_Options.print_universes ()) then begin ( -let _39_602 = (let _134_322 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow (((tps), (c)))) None FStar_Range.dummyRange) +let _39_603 = (let _134_322 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow (((tps), (c)))) None FStar_Range.dummyRange) in (FStar_Syntax_Subst.open_univ_vars univs _134_322)) -in (match (_39_602) with +in (match (_39_603) with | (univs, t) -> begin ( -let _39_611 = (match ((let _134_323 = (FStar_Syntax_Subst.compress t) +let _39_612 = (match ((let _134_323 = (FStar_Syntax_Subst.compress t) in _134_323.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_arrow (bs, c) -> begin ((bs), (c)) end -| _39_608 -> begin +| _39_609 -> begin (FStar_All.failwith "impossible") end) -in (match (_39_611) with +in (match (_39_612) with | (tps, c) -> begin (let _134_327 = (sli l) in (let _134_326 = (univ_names_to_string univs) @@ -1020,12 +1020,12 @@ in (FStar_Util.format2 "%s: %s\n" _134_335 msg))) let rec sigelt_to_string_short : FStar_Syntax_Syntax.sigelt -> Prims.string = (fun x -> (match (x) with -| FStar_Syntax_Syntax.Sig_let ((_39_616, ({FStar_Syntax_Syntax.lbname = lb; FStar_Syntax_Syntax.lbunivs = _39_623; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _39_620; FStar_Syntax_Syntax.lbdef = _39_618})::[]), _39_629, _39_631, _39_633) -> begin +| FStar_Syntax_Syntax.Sig_let ((_39_617, ({FStar_Syntax_Syntax.lbname = lb; FStar_Syntax_Syntax.lbunivs = _39_624; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = _39_621; FStar_Syntax_Syntax.lbdef = _39_619})::[]), _39_630, _39_632, _39_634) -> begin (let _134_339 = (lbname_to_string lb) in (let _134_338 = (term_to_string t) in (FStar_Util.format2 "let %s : %s" _134_339 _134_338))) end -| _39_637 -> begin +| _39_638 -> begin (let _134_342 = (let _134_341 = (FStar_Syntax_Util.lids_of_sigelt x) in (FStar_All.pipe_right _134_341 (FStar_List.map (fun l -> l.FStar_Ident.str)))) in (FStar_All.pipe_right _134_342 (FStar_String.concat ", "))) @@ -1074,20 +1074,20 @@ let abs_ascription_to_string : (FStar_Syntax_Syntax.lcomp, FStar_Ident.lident) F let strb = (FStar_Util.new_string_builder ()) in ( -let _39_675 = (match (ascription) with +let _39_676 = (match (ascription) with | None -> begin (FStar_Util.string_builder_append strb "None") end | Some (FStar_Util.Inl (lc)) -> begin ( -let _39_668 = (FStar_Util.string_builder_append strb "Some Inr ") +let _39_669 = (FStar_Util.string_builder_append strb "Some Inr ") in (FStar_Util.string_builder_append strb (FStar_Ident.text_of_lid lc.FStar_Syntax_Syntax.eff_name))) end | Some (FStar_Util.Inr (lid)) -> begin ( -let _39_673 = (FStar_Util.string_builder_append strb "Some Inr ") +let _39_674 = (FStar_Util.string_builder_append strb "Some Inr ") in (FStar_Util.string_builder_append strb (FStar_Ident.text_of_lid lid))) end) in (FStar_Util.string_of_string_builder strb)))) diff --git a/src/ocaml-output/FStar_Syntax_Syntax.ml b/src/ocaml-output/FStar_Syntax_Syntax.ml index 452556690dd..2d4fc3cd0c3 100755 --- a/src/ocaml-output/FStar_Syntax_Syntax.ml +++ b/src/ocaml-output/FStar_Syntax_Syntax.ml @@ -14,8 +14,8 @@ end)) let ___Err____0 = (fun projectee -> (match (projectee) with -| Err (_33_7) -> begin -_33_7 +| Err (_33_8) -> begin +_33_8 end)) @@ -32,8 +32,8 @@ end)) let ___Error____0 = (fun projectee -> (match (projectee) with -| Error (_33_9) -> begin -_33_9 +| Error (_33_10) -> begin +_33_10 end)) @@ -50,8 +50,8 @@ end)) let ___Warning____0 = (fun projectee -> (match (projectee) with -| Warning (_33_11) -> begin -_33_11 +| Warning (_33_12) -> begin +_33_12 end)) @@ -98,14 +98,14 @@ end)) let ___SetOptions____0 = (fun projectee -> (match (projectee) with -| SetOptions (_33_21) -> begin -_33_21 +| SetOptions (_33_22) -> begin +_33_22 end)) let ___ResetOptions____0 = (fun projectee -> (match (projectee) with -| ResetOptions (_33_24) -> begin -_33_24 +| ResetOptions (_33_25) -> begin +_33_25 end)) @@ -137,8 +137,8 @@ end)) let ___Implicit____0 = (fun projectee -> (match (projectee) with -| Implicit (_33_28) -> begin -_33_28 +| Implicit (_33_29) -> begin +_33_29 end)) @@ -222,32 +222,32 @@ end)) let ___U_succ____0 = (fun projectee -> (match (projectee) with -| U_succ (_33_31) -> begin -_33_31 +| U_succ (_33_32) -> begin +_33_32 end)) let ___U_max____0 = (fun projectee -> (match (projectee) with -| U_max (_33_34) -> begin -_33_34 +| U_max (_33_35) -> begin +_33_35 end)) let ___U_bvar____0 = (fun projectee -> (match (projectee) with -| U_bvar (_33_37) -> begin -_33_37 +| U_bvar (_33_38) -> begin +_33_38 end)) let ___U_name____0 = (fun projectee -> (match (projectee) with -| U_name (_33_40) -> begin -_33_40 +| U_name (_33_41) -> begin +_33_41 end)) let ___U_unif____0 = (fun projectee -> (match (projectee) with -| U_unif (_33_43) -> begin -_33_43 +| U_unif (_33_44) -> begin +_33_44 end)) @@ -311,14 +311,14 @@ end)) let ___Delta_defined_at_level____0 = (fun projectee -> (match (projectee) with -| Delta_defined_at_level (_33_46) -> begin -_33_46 +| Delta_defined_at_level (_33_47) -> begin +_33_47 end)) let ___Delta_abstract____0 = (fun projectee -> (match (projectee) with -| Delta_abstract (_33_49) -> begin -_33_49 +| Delta_abstract (_33_50) -> begin +_33_50 end)) @@ -959,242 +959,242 @@ let is_Mklcomp : lcomp -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwi let ___Tm_bvar____0 = (fun projectee -> (match (projectee) with -| Tm_bvar (_33_82) -> begin -_33_82 +| Tm_bvar (_33_83) -> begin +_33_83 end)) let ___Tm_name____0 = (fun projectee -> (match (projectee) with -| Tm_name (_33_85) -> begin -_33_85 +| Tm_name (_33_86) -> begin +_33_86 end)) let ___Tm_fvar____0 = (fun projectee -> (match (projectee) with -| Tm_fvar (_33_88) -> begin -_33_88 +| Tm_fvar (_33_89) -> begin +_33_89 end)) let ___Tm_uinst____0 = (fun projectee -> (match (projectee) with -| Tm_uinst (_33_91) -> begin -_33_91 +| Tm_uinst (_33_92) -> begin +_33_92 end)) let ___Tm_constant____0 = (fun projectee -> (match (projectee) with -| Tm_constant (_33_94) -> begin -_33_94 +| Tm_constant (_33_95) -> begin +_33_95 end)) let ___Tm_type____0 = (fun projectee -> (match (projectee) with -| Tm_type (_33_97) -> begin -_33_97 +| Tm_type (_33_98) -> begin +_33_98 end)) let ___Tm_abs____0 = (fun projectee -> (match (projectee) with -| Tm_abs (_33_100) -> begin -_33_100 +| Tm_abs (_33_101) -> begin +_33_101 end)) let ___Tm_arrow____0 = (fun projectee -> (match (projectee) with -| Tm_arrow (_33_103) -> begin -_33_103 +| Tm_arrow (_33_104) -> begin +_33_104 end)) let ___Tm_refine____0 = (fun projectee -> (match (projectee) with -| Tm_refine (_33_106) -> begin -_33_106 +| Tm_refine (_33_107) -> begin +_33_107 end)) let ___Tm_app____0 = (fun projectee -> (match (projectee) with -| Tm_app (_33_109) -> begin -_33_109 +| Tm_app (_33_110) -> begin +_33_110 end)) let ___Tm_match____0 = (fun projectee -> (match (projectee) with -| Tm_match (_33_112) -> begin -_33_112 +| Tm_match (_33_113) -> begin +_33_113 end)) let ___Tm_ascribed____0 = (fun projectee -> (match (projectee) with -| Tm_ascribed (_33_115) -> begin -_33_115 +| Tm_ascribed (_33_116) -> begin +_33_116 end)) let ___Tm_let____0 = (fun projectee -> (match (projectee) with -| Tm_let (_33_118) -> begin -_33_118 +| Tm_let (_33_119) -> begin +_33_119 end)) let ___Tm_uvar____0 = (fun projectee -> (match (projectee) with -| Tm_uvar (_33_121) -> begin -_33_121 +| Tm_uvar (_33_122) -> begin +_33_122 end)) let ___Tm_delayed____0 = (fun projectee -> (match (projectee) with -| Tm_delayed (_33_124) -> begin -_33_124 +| Tm_delayed (_33_125) -> begin +_33_125 end)) let ___Tm_meta____0 = (fun projectee -> (match (projectee) with -| Tm_meta (_33_127) -> begin -_33_127 +| Tm_meta (_33_128) -> begin +_33_128 end)) let ___Pat_constant____0 = (fun projectee -> (match (projectee) with -| Pat_constant (_33_130) -> begin -_33_130 +| Pat_constant (_33_131) -> begin +_33_131 end)) let ___Pat_disj____0 = (fun projectee -> (match (projectee) with -| Pat_disj (_33_133) -> begin -_33_133 +| Pat_disj (_33_134) -> begin +_33_134 end)) let ___Pat_cons____0 = (fun projectee -> (match (projectee) with -| Pat_cons (_33_136) -> begin -_33_136 +| Pat_cons (_33_137) -> begin +_33_137 end)) let ___Pat_var____0 = (fun projectee -> (match (projectee) with -| Pat_var (_33_139) -> begin -_33_139 +| Pat_var (_33_140) -> begin +_33_140 end)) let ___Pat_wild____0 = (fun projectee -> (match (projectee) with -| Pat_wild (_33_142) -> begin -_33_142 +| Pat_wild (_33_143) -> begin +_33_143 end)) let ___Pat_dot_term____0 = (fun projectee -> (match (projectee) with -| Pat_dot_term (_33_145) -> begin -_33_145 +| Pat_dot_term (_33_146) -> begin +_33_146 end)) let ___Total____0 = (fun projectee -> (match (projectee) with -| Total (_33_150) -> begin -_33_150 +| Total (_33_151) -> begin +_33_151 end)) let ___GTotal____0 = (fun projectee -> (match (projectee) with -| GTotal (_33_153) -> begin -_33_153 +| GTotal (_33_154) -> begin +_33_154 end)) let ___Comp____0 = (fun projectee -> (match (projectee) with -| Comp (_33_156) -> begin -_33_156 +| Comp (_33_157) -> begin +_33_157 end)) let ___DECREASES____0 = (fun projectee -> (match (projectee) with -| DECREASES (_33_159) -> begin -_33_159 +| DECREASES (_33_160) -> begin +_33_160 end)) let ___Meta_pattern____0 = (fun projectee -> (match (projectee) with -| Meta_pattern (_33_162) -> begin -_33_162 +| Meta_pattern (_33_163) -> begin +_33_163 end)) let ___Meta_named____0 = (fun projectee -> (match (projectee) with -| Meta_named (_33_165) -> begin -_33_165 +| Meta_named (_33_166) -> begin +_33_166 end)) let ___Meta_labeled____0 = (fun projectee -> (match (projectee) with -| Meta_labeled (_33_168) -> begin -_33_168 +| Meta_labeled (_33_169) -> begin +_33_169 end)) let ___Meta_desugared____0 = (fun projectee -> (match (projectee) with -| Meta_desugared (_33_171) -> begin -_33_171 +| Meta_desugared (_33_172) -> begin +_33_172 end)) let ___Meta_monadic____0 = (fun projectee -> (match (projectee) with -| Meta_monadic (_33_174) -> begin -_33_174 +| Meta_monadic (_33_175) -> begin +_33_175 end)) let ___Meta_monadic_lift____0 = (fun projectee -> (match (projectee) with -| Meta_monadic_lift (_33_177) -> begin -_33_177 +| Meta_monadic_lift (_33_178) -> begin +_33_178 end)) let ___Fixed____0 = (fun projectee -> (match (projectee) with -| Fixed (_33_180) -> begin -_33_180 +| Fixed (_33_181) -> begin +_33_181 end)) let ___Record_projector____0 = (fun projectee -> (match (projectee) with -| Record_projector (_33_183) -> begin -_33_183 +| Record_projector (_33_184) -> begin +_33_184 end)) let ___Record_ctor____0 = (fun projectee -> (match (projectee) with -| Record_ctor (_33_186) -> begin -_33_186 +| Record_ctor (_33_187) -> begin +_33_187 end)) let ___DB____0 = (fun projectee -> (match (projectee) with -| DB (_33_189) -> begin -_33_189 +| DB (_33_190) -> begin +_33_190 end)) let ___NM____0 = (fun projectee -> (match (projectee) with -| NM (_33_192) -> begin -_33_192 +| NM (_33_193) -> begin +_33_193 end)) let ___NT____0 = (fun projectee -> (match (projectee) with -| NT (_33_195) -> begin -_33_195 +| NT (_33_196) -> begin +_33_196 end)) let ___UN____0 = (fun projectee -> (match (projectee) with -| UN (_33_198) -> begin -_33_198 +| UN (_33_199) -> begin +_33_199 end)) let ___UD____0 = (fun projectee -> (match (projectee) with -| UD (_33_201) -> begin -_33_201 +| UD (_33_202) -> begin +_33_202 end)) @@ -1228,7 +1228,7 @@ type qualifier = | TotalEffect | Logic | Reifiable -| Reflectable +| Reflectable of FStar_Ident.lident | Discriminator of FStar_Ident.lident | Projector of (FStar_Ident.lident * FStar_Ident.ident) | RecordType of fieldname Prims.list @@ -1427,27 +1427,33 @@ false end)) +let ___Reflectable____0 = (fun projectee -> (match (projectee) with +| Reflectable (_33_210) -> begin +_33_210 +end)) + + let ___Discriminator____0 = (fun projectee -> (match (projectee) with -| Discriminator (_33_209) -> begin -_33_209 +| Discriminator (_33_213) -> begin +_33_213 end)) let ___Projector____0 = (fun projectee -> (match (projectee) with -| Projector (_33_212) -> begin -_33_212 +| Projector (_33_216) -> begin +_33_216 end)) let ___RecordType____0 = (fun projectee -> (match (projectee) with -| RecordType (_33_215) -> begin -_33_215 +| RecordType (_33_219) -> begin +_33_219 end)) let ___RecordConstructor____0 = (fun projectee -> (match (projectee) with -| RecordConstructor (_33_218) -> begin -_33_218 +| RecordConstructor (_33_222) -> begin +_33_222 end)) @@ -1470,7 +1476,7 @@ let is_Mksub_eff : sub_eff -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.fa type action = -{action_name : FStar_Ident.lident; action_univs : univ_names; action_defn : term; action_typ : typ} +{action_name : FStar_Ident.lident; action_unqualified_name : FStar_Ident.ident; action_univs : univ_names; action_defn : term; action_typ : typ} let is_Mkaction : action -> Prims.bool = (Obj.magic ((fun _ -> (FStar_All.failwith "Not yet implemented:is_Mkaction")))) @@ -1605,74 +1611,74 @@ end)) let ___Sig_inductive_typ____0 = (fun projectee -> (match (projectee) with -| Sig_inductive_typ (_33_255) -> begin -_33_255 +| Sig_inductive_typ (_33_260) -> begin +_33_260 end)) let ___Sig_bundle____0 = (fun projectee -> (match (projectee) with -| Sig_bundle (_33_258) -> begin -_33_258 +| Sig_bundle (_33_263) -> begin +_33_263 end)) let ___Sig_datacon____0 = (fun projectee -> (match (projectee) with -| Sig_datacon (_33_261) -> begin -_33_261 +| Sig_datacon (_33_266) -> begin +_33_266 end)) let ___Sig_declare_typ____0 = (fun projectee -> (match (projectee) with -| Sig_declare_typ (_33_264) -> begin -_33_264 +| Sig_declare_typ (_33_269) -> begin +_33_269 end)) let ___Sig_let____0 = (fun projectee -> (match (projectee) with -| Sig_let (_33_267) -> begin -_33_267 +| Sig_let (_33_272) -> begin +_33_272 end)) let ___Sig_main____0 = (fun projectee -> (match (projectee) with -| Sig_main (_33_270) -> begin -_33_270 +| Sig_main (_33_275) -> begin +_33_275 end)) let ___Sig_assume____0 = (fun projectee -> (match (projectee) with -| Sig_assume (_33_273) -> begin -_33_273 +| Sig_assume (_33_278) -> begin +_33_278 end)) let ___Sig_new_effect____0 = (fun projectee -> (match (projectee) with -| Sig_new_effect (_33_276) -> begin -_33_276 +| Sig_new_effect (_33_281) -> begin +_33_281 end)) let ___Sig_new_effect_for_free____0 = (fun projectee -> (match (projectee) with -| Sig_new_effect_for_free (_33_279) -> begin -_33_279 +| Sig_new_effect_for_free (_33_284) -> begin +_33_284 end)) let ___Sig_sub_effect____0 = (fun projectee -> (match (projectee) with -| Sig_sub_effect (_33_282) -> begin -_33_282 +| Sig_sub_effect (_33_287) -> begin +_33_287 end)) let ___Sig_effect_abbrev____0 = (fun projectee -> (match (projectee) with -| Sig_effect_abbrev (_33_285) -> begin -_33_285 +| Sig_effect_abbrev (_33_290) -> begin +_33_290 end)) let ___Sig_pragma____0 = (fun projectee -> (match (projectee) with -| Sig_pragma (_33_288) -> begin -_33_288 +| Sig_pragma (_33_293) -> begin +_33_293 end)) @@ -1703,6 +1709,15 @@ type mk_t = (term', term') mk_t_a +let contains_reflectable : qualifier Prims.list -> Prims.bool = (fun l -> (FStar_Util.for_some (fun _33_1 -> (match (_33_1) with +| Reflectable (_33_310) -> begin +true +end +| _33_313 -> begin +false +end)) l)) + + let withinfo = (fun v s r -> {v = v; ty = s; p = r}) @@ -1736,44 +1751,44 @@ let range_of_bv : bv -> FStar_Range.range = (fun x -> x.ppname.FStar_Ident.idR let set_range_of_bv : bv -> FStar_Range.range -> bv = (fun x r -> ( -let _33_320 = x -in {ppname = (FStar_Ident.mk_ident ((x.ppname.FStar_Ident.idText), (r))); index = _33_320.index; sort = _33_320.sort})) +let _33_332 = x +in {ppname = (FStar_Ident.mk_ident ((x.ppname.FStar_Ident.idText), (r))); index = _33_332.index; sort = _33_332.sort})) let syn = (fun p k f -> (f k p)) -let mk_fvs = (fun _33_325 -> (match (()) with +let mk_fvs = (fun _33_337 -> (match (()) with | () -> begin (FStar_Util.mk_ref None) end)) -let mk_uvs = (fun _33_326 -> (match (()) with +let mk_uvs = (fun _33_338 -> (match (()) with | () -> begin (FStar_Util.mk_ref None) end)) -let new_bv_set : Prims.unit -> bv FStar_Util.set = (fun _33_327 -> (match (()) with +let new_bv_set : Prims.unit -> bv FStar_Util.set = (fun _33_339 -> (match (()) with | () -> begin (FStar_Util.new_set order_bv (fun x -> (x.index + (FStar_Util.hashcode x.ppname.FStar_Ident.idText)))) end)) -let new_uv_set : Prims.unit -> uvars = (fun _33_329 -> (match (()) with +let new_uv_set : Prims.unit -> uvars = (fun _33_341 -> (match (()) with | () -> begin -(FStar_Util.new_set (fun _33_337 _33_341 -> (match (((_33_337), (_33_341))) with -| ((x, _33_336), (y, _33_340)) -> begin +(FStar_Util.new_set (fun _33_349 _33_353 -> (match (((_33_349), (_33_353))) with +| ((x, _33_348), (y, _33_352)) -> begin ((FStar_Unionfind.uvar_id x) - (FStar_Unionfind.uvar_id y)) -end)) (fun _33_333 -> (match (_33_333) with -| (x, _33_332) -> begin +end)) (fun _33_345 -> (match (_33_345) with +| (x, _33_344) -> begin (FStar_Unionfind.uvar_id x) end))) end)) -let new_universe_uvar_set : Prims.unit -> universe_uvar FStar_Util.set = (fun _33_342 -> (match (()) with +let new_universe_uvar_set : Prims.unit -> universe_uvar FStar_Util.set = (fun _33_354 -> (match (()) with | () -> begin (FStar_Util.new_set (fun x y -> ((FStar_Unionfind.uvar_id x) - (FStar_Unionfind.uvar_id y))) (fun x -> (FStar_Unionfind.uvar_id x))) end)) @@ -1803,38 +1818,38 @@ let freenames_of_list : bv Prims.list -> freenames = (fun l -> (FStar_List.fol let list_of_freenames : freenames -> bv Prims.list = (fun fvs -> (FStar_Util.set_elements fvs)) -let mk = (fun t topt r -> (let _128_1276 = (FStar_Util.mk_ref topt) -in (let _128_1275 = (FStar_Util.mk_ref None) -in {n = t; tk = _128_1276; pos = r; vars = _128_1275}))) +let mk = (fun t topt r -> (let _128_1295 = (FStar_Util.mk_ref topt) +in (let _128_1294 = (FStar_Util.mk_ref None) +in {n = t; tk = _128_1295; pos = r; vars = _128_1294}))) -let bv_to_tm : bv -> term = (fun bv -> (let _128_1279 = (range_of_bv bv) -in (mk (Tm_bvar (bv)) (Some (bv.sort.n)) _128_1279))) +let bv_to_tm : bv -> term = (fun bv -> (let _128_1298 = (range_of_bv bv) +in (mk (Tm_bvar (bv)) (Some (bv.sort.n)) _128_1298))) -let bv_to_name : bv -> term = (fun bv -> (let _128_1282 = (range_of_bv bv) -in (mk (Tm_name (bv)) (Some (bv.sort.n)) _128_1282))) +let bv_to_name : bv -> term = (fun bv -> (let _128_1301 = (range_of_bv bv) +in (mk (Tm_name (bv)) (Some (bv.sort.n)) _128_1301))) let mk_Tm_app : term -> args -> mk_t = (fun t1 args k p -> (match (args) with | [] -> begin t1 end -| _33_361 -> begin +| _33_373 -> begin (mk (Tm_app (((t1), (args)))) k p) end)) -let mk_Tm_uinst : term -> universes -> term = (fun t _33_1 -> (match (_33_1) with +let mk_Tm_uinst : term -> universes -> term = (fun t _33_2 -> (match (_33_2) with | [] -> begin t end | us -> begin (match (t.n) with -| Tm_fvar (_33_367) -> begin +| Tm_fvar (_33_379) -> begin (mk (Tm_uinst (((t), (us)))) None t.pos) end -| _33_370 -> begin +| _33_382 -> begin (FStar_All.failwith "Unexpected universe instantiation") end) end)) @@ -1844,7 +1859,7 @@ let extend_app_n : term -> args -> mk_t = (fun t args' kopt r -> (match (t.n | Tm_app (head, args) -> begin (mk_Tm_app head (FStar_List.append args args') kopt r) end -| _33_380 -> begin +| _33_392 -> begin (mk_Tm_app t args' kopt r) end)) @@ -1852,10 +1867,10 @@ end)) let extend_app : term -> arg -> mk_t = (fun t arg kopt r -> (extend_app_n t ((arg)::[]) kopt r)) -let mk_Tm_delayed : ((term * subst_ts), Prims.unit -> term) FStar_Util.either -> FStar_Range.range -> term = (fun lr pos -> (let _128_1317 = (let _128_1316 = (let _128_1315 = (FStar_Util.mk_ref None) -in ((lr), (_128_1315))) -in Tm_delayed (_128_1316)) -in (mk _128_1317 None pos))) +let mk_Tm_delayed : ((term * subst_ts), Prims.unit -> term) FStar_Util.either -> FStar_Range.range -> term = (fun lr pos -> (let _128_1336 = (let _128_1335 = (let _128_1334 = (FStar_Util.mk_ref None) +in ((lr), (_128_1334))) +in Tm_delayed (_128_1335)) +in (mk _128_1336 None pos))) let mk_Total' : typ -> universe Prims.option -> comp = (fun t u -> (mk (Total (((t), (u)))) None t.pos)) @@ -1873,7 +1888,7 @@ let mk_GTotal : typ -> comp = (fun t -> (mk_GTotal' t None)) let mk_Comp : comp_typ -> comp = (fun ct -> (mk (Comp (ct)) None ct.result_typ.pos)) -let mk_lb : (lbname * univ_name Prims.list * FStar_Ident.lident * typ * term) -> letbinding = (fun _33_399 -> (match (_33_399) with +let mk_lb : (lbname * univ_name Prims.list * FStar_Ident.lident * typ * term) -> letbinding = (fun _33_411 -> (match (_33_411) with | (x, univs, eff, t, e) -> begin {lbname = x; lbunivs = univs; lbtyp = t; lbeff = eff; lbdef = e} end)) @@ -1898,16 +1913,16 @@ let is_teff : term -> Prims.bool = (fun t -> (match (t.n) with | Tm_constant (FStar_Const.Const_effect) -> begin true end -| _33_408 -> begin +| _33_420 -> begin false end)) let is_type : term -> Prims.bool = (fun t -> (match (t.n) with -| Tm_type (_33_411) -> begin +| Tm_type (_33_423) -> begin true end -| _33_414 -> begin +| _33_426 -> begin false end)) @@ -1921,8 +1936,8 @@ let null_bv : term -> bv = (fun k -> {ppname = null_id; index = (Prims.parse_i let mk_binder : bv -> binder = (fun a -> ((a), (None))) -let null_binder : term -> binder = (fun t -> (let _128_1352 = (null_bv t) -in ((_128_1352), (None)))) +let null_binder : term -> binder = (fun t -> (let _128_1371 = (null_bv t) +in ((_128_1371), (None)))) let imp_tag : arg_qualifier = Implicit (false) @@ -1940,17 +1955,17 @@ let is_null_bv : bv -> Prims.bool = (fun b -> (b.ppname.FStar_Ident.idText = n let is_null_binder : binder -> Prims.bool = (fun b -> (is_null_bv (Prims.fst b))) -let is_top_level : letbinding Prims.list -> Prims.bool = (fun _33_2 -> (match (_33_2) with -| ({lbname = FStar_Util.Inr (_33_434); lbunivs = _33_432; lbtyp = _33_430; lbeff = _33_428; lbdef = _33_426})::_33_424 -> begin +let is_top_level : letbinding Prims.list -> Prims.bool = (fun _33_3 -> (match (_33_3) with +| ({lbname = FStar_Util.Inr (_33_446); lbunivs = _33_444; lbtyp = _33_442; lbeff = _33_440; lbdef = _33_438})::_33_436 -> begin true end -| _33_439 -> begin +| _33_451 -> begin false end)) -let freenames_of_binders : binders -> freenames = (fun bs -> (FStar_List.fold_right (fun _33_444 out -> (match (_33_444) with -| (x, _33_443) -> begin +let freenames_of_binders : binders -> freenames = (fun bs -> (FStar_List.fold_right (fun _33_456 out -> (match (_33_456) with +| (x, _33_455) -> begin (FStar_Util.set_add x out) end)) bs no_names)) @@ -1958,24 +1973,24 @@ end)) bs no_names)) let binders_of_list : bv Prims.list -> binders = (fun fvs -> (FStar_All.pipe_right fvs (FStar_List.map (fun t -> ((t), (None)))))) -let binders_of_freenames : freenames -> binders = (fun fvs -> (let _128_1372 = (FStar_Util.set_elements fvs) -in (FStar_All.pipe_right _128_1372 binders_of_list))) +let binders_of_freenames : freenames -> binders = (fun fvs -> (let _128_1391 = (FStar_Util.set_elements fvs) +in (FStar_All.pipe_right _128_1391 binders_of_list))) -let is_implicit : aqual -> Prims.bool = (fun _33_3 -> (match (_33_3) with -| Some (Implicit (_33_451)) -> begin +let is_implicit : aqual -> Prims.bool = (fun _33_4 -> (match (_33_4) with +| Some (Implicit (_33_463)) -> begin true end -| _33_455 -> begin +| _33_467 -> begin false end)) -let as_implicit : Prims.bool -> aqual = (fun _33_4 -> (match (_33_4) with +let as_implicit : Prims.bool -> aqual = (fun _33_5 -> (match (_33_5) with | true -> begin Some (imp_tag) end -| _33_459 -> begin +| _33_471 -> begin None end)) @@ -1989,20 +2004,20 @@ end | (Pat_wild (x)) | (Pat_var (x)) -> begin (x)::b end -| Pat_cons (_33_474, pats) -> begin -(FStar_List.fold_left (fun b _33_482 -> (match (_33_482) with -| (p, _33_481) -> begin +| Pat_cons (_33_486, pats) -> begin +(FStar_List.fold_left (fun b _33_494 -> (match (_33_494) with +| (p, _33_493) -> begin (aux b p) end)) b pats) end -| Pat_disj ((p)::_33_484) -> begin +| Pat_disj ((p)::_33_496) -> begin (aux b p) end | Pat_disj ([]) -> begin (FStar_All.failwith "impossible") end)) -in (let _128_1385 = (aux [] p) -in (FStar_All.pipe_left FStar_List.rev _128_1385)))) +in (let _128_1404 = (aux [] p) +in (FStar_All.pipe_left FStar_List.rev _128_1404)))) let gen_reset : ((Prims.unit -> Prims.int) * (Prims.unit -> Prims.unit)) = ( @@ -2010,16 +2025,16 @@ let gen_reset : ((Prims.unit -> Prims.int) * (Prims.unit -> Prims.unit)) = ( let x = (FStar_ST.alloc (Prims.parse_int "0")) in ( -let gen = (fun _33_492 -> (match (()) with +let gen = (fun _33_504 -> (match (()) with | () -> begin ( -let _33_493 = (FStar_Util.incr x) +let _33_505 = (FStar_Util.incr x) in (FStar_ST.read x)) end)) in ( -let reset = (fun _33_496 -> (match (()) with +let reset = (fun _33_508 -> (match (()) with | () -> begin (FStar_ST.op_Colon_Equals x (Prims.parse_int "0")) end)) @@ -2032,7 +2047,7 @@ let next_id : Prims.unit -> Prims.int = (Prims.fst gen_reset) let reset_gensym : Prims.unit -> Prims.unit = (Prims.snd gen_reset) -let range_of_ropt : FStar_Range.range Prims.option -> FStar_Range.range = (fun _33_5 -> (match (_33_5) with +let range_of_ropt : FStar_Range.range Prims.option -> FStar_Range.range = (fun _33_6 -> (match (_33_6) with | None -> begin FStar_Range.dummyRange end @@ -2044,32 +2059,32 @@ end)) let gen_bv : Prims.string -> FStar_Range.range Prims.option -> typ -> bv = (fun s r t -> ( let id = (FStar_Ident.mk_ident ((s), ((range_of_ropt r)))) -in (let _128_1410 = (next_id ()) -in {ppname = id; index = _128_1410; sort = t}))) +in (let _128_1429 = (next_id ()) +in {ppname = id; index = _128_1429; sort = t}))) let new_bv : FStar_Range.range Prims.option -> typ -> bv = (fun ropt t -> (gen_bv FStar_Ident.reserved_prefix ropt t)) let freshen_bv : bv -> bv = (fun bv -> if (is_null_bv bv) then begin -(let _128_1418 = (let _128_1417 = (range_of_bv bv) -in Some (_128_1417)) -in (new_bv _128_1418 bv.sort)) +(let _128_1437 = (let _128_1436 = (range_of_bv bv) +in Some (_128_1436)) +in (new_bv _128_1437 bv.sort)) end else begin ( -let _33_508 = bv -in (let _128_1419 = (next_id ()) -in {ppname = _33_508.ppname; index = _128_1419; sort = _33_508.sort})) +let _33_520 = bv +in (let _128_1438 = (next_id ()) +in {ppname = _33_520.ppname; index = _128_1438; sort = _33_520.sort})) end) let new_univ_name : FStar_Range.range Prims.option -> univ_name = (fun ropt -> ( let id = (next_id ()) -in (let _128_1423 = (let _128_1422 = (FStar_Util.string_of_int id) -in ((_128_1422), ((range_of_ropt ropt)))) -in (FStar_Ident.mk_ident _128_1423)))) +in (let _128_1442 = (let _128_1441 = (FStar_Util.string_of_int id) +in ((_128_1441), ((range_of_ropt ropt)))) +in (FStar_Ident.mk_ident _128_1442)))) let mkbv : FStar_Ident.ident -> Prims.int -> term -> bv = (fun x y t -> {ppname = x; index = y; sort = t}) @@ -2082,7 +2097,7 @@ end | (FStar_Util.Inr (l), FStar_Util.Inr (m)) -> begin (FStar_Ident.lid_equals l m) end -| _33_528 -> begin +| _33_540 -> begin false end)) @@ -2095,26 +2110,26 @@ let fv_eq_lid : fv -> FStar_Ident.lident -> Prims.bool = (fun fv lid -> (FSt let set_bv_range : bv -> FStar_Range.range -> bv = (fun bv r -> ( -let _33_535 = bv -in {ppname = (FStar_Ident.mk_ident ((bv.ppname.FStar_Ident.idText), (r))); index = _33_535.index; sort = _33_535.sort})) +let _33_547 = bv +in {ppname = (FStar_Ident.mk_ident ((bv.ppname.FStar_Ident.idText), (r))); index = _33_547.index; sort = _33_547.sort})) -let lid_as_fv : FStar_Ident.lident -> delta_depth -> fv_qual Prims.option -> fv = (fun l dd dq -> (let _128_1452 = (withinfo l tun (FStar_Ident.range_of_lid l)) -in {fv_name = _128_1452; fv_delta = dd; fv_qual = dq})) +let lid_as_fv : FStar_Ident.lident -> delta_depth -> fv_qual Prims.option -> fv = (fun l dd dq -> (let _128_1471 = (withinfo l tun (FStar_Ident.range_of_lid l)) +in {fv_name = _128_1471; fv_delta = dd; fv_qual = dq})) let fv_to_tm : fv -> term = (fun fv -> (mk (Tm_fvar (fv)) None (FStar_Ident.range_of_lid fv.fv_name.v))) -let fvar : FStar_Ident.lident -> delta_depth -> fv_qual Prims.option -> term = (fun l dd dq -> (let _128_1461 = (lid_as_fv l dd dq) -in (fv_to_tm _128_1461))) +let fvar : FStar_Ident.lident -> delta_depth -> fv_qual Prims.option -> term = (fun l dd dq -> (let _128_1480 = (lid_as_fv l dd dq) +in (fv_to_tm _128_1480))) let lid_of_fv : fv -> FStar_Ident.lid = (fun fv -> fv.fv_name.v) -let range_of_fv : fv -> FStar_Range.range = (fun fv -> (let _128_1466 = (lid_of_fv fv) -in (FStar_Ident.range_of_lid _128_1466))) +let range_of_fv : fv -> FStar_Range.range = (fun fv -> (let _128_1485 = (lid_of_fv fv) +in (FStar_Ident.range_of_lid _128_1485))) diff --git a/src/ocaml-output/FStar_Syntax_Util.ml b/src/ocaml-output/FStar_Syntax_Util.ml index a7f20b1d5d4..ed562b4d6b1 100755 --- a/src/ocaml-output/FStar_Syntax_Util.ml +++ b/src/ocaml-output/FStar_Syntax_Util.ml @@ -1,7 +1,11 @@ open Prims -let mk_discriminator : FStar_Ident.lident -> FStar_Ident.lident = (fun lid -> (FStar_Ident.lid_of_ids (FStar_List.append lid.FStar_Ident.ns (((FStar_Ident.mk_ident (((Prims.strcat "is_" lid.FStar_Ident.ident.FStar_Ident.idText)), (lid.FStar_Ident.ident.FStar_Ident.idRange))))::[])))) +let qual_id : FStar_Ident.lident -> FStar_Ident.ident -> FStar_Ident.lident = (fun lid id -> (let _133_5 = (FStar_Ident.lid_of_ids (FStar_List.append lid.FStar_Ident.ns ((lid.FStar_Ident.ident)::(id)::[]))) +in (FStar_Ident.set_lid_range _133_5 id.FStar_Ident.idRange))) + + +let mk_discriminator : FStar_Ident.lident -> FStar_Ident.lident = (fun lid -> (FStar_Ident.lid_of_ids (FStar_List.append lid.FStar_Ident.ns (((FStar_Ident.mk_ident (((Prims.strcat FStar_Ident.reserved_prefix (Prims.strcat "is_" lid.FStar_Ident.ident.FStar_Ident.idText))), (lid.FStar_Ident.ident.FStar_Ident.idRange))))::[])))) let is_name : FStar_Ident.lident -> Prims.bool = (fun lid -> ( @@ -10,46 +14,46 @@ let c = (FStar_Util.char_at lid.FStar_Ident.ident.FStar_Ident.idText (Prims.pars in (FStar_Util.is_upper c))) -let arg_of_non_null_binder = (fun _38_16 -> (match (_38_16) with +let arg_of_non_null_binder = (fun _38_18 -> (match (_38_18) with | (b, imp) -> begin -(let _133_6 = (FStar_Syntax_Syntax.bv_to_name b) -in ((_133_6), (imp))) +(let _133_11 = (FStar_Syntax_Syntax.bv_to_name b) +in ((_133_11), (imp))) end)) let args_of_non_null_binders : FStar_Syntax_Syntax.binders -> (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list = (fun binders -> (FStar_All.pipe_right binders (FStar_List.collect (fun b -> if (FStar_Syntax_Syntax.is_null_binder b) then begin [] end else begin -(let _133_10 = (arg_of_non_null_binder b) -in (_133_10)::[]) +(let _133_15 = (arg_of_non_null_binder b) +in (_133_15)::[]) end)))) -let args_of_binders : FStar_Syntax_Syntax.binders -> ((FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list * (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list) = (fun binders -> (let _133_17 = (FStar_All.pipe_right binders (FStar_List.map (fun b -> if (FStar_Syntax_Syntax.is_null_binder b) then begin +let args_of_binders : FStar_Syntax_Syntax.binders -> ((FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list * (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list) = (fun binders -> (let _133_22 = (FStar_All.pipe_right binders (FStar_List.map (fun b -> if (FStar_Syntax_Syntax.is_null_binder b) then begin ( -let b = (let _133_14 = (FStar_Syntax_Syntax.new_bv None (Prims.fst b).FStar_Syntax_Syntax.sort) -in ((_133_14), ((Prims.snd b)))) -in (let _133_15 = (arg_of_non_null_binder b) -in ((b), (_133_15)))) +let b = (let _133_19 = (FStar_Syntax_Syntax.new_bv None (Prims.fst b).FStar_Syntax_Syntax.sort) +in ((_133_19), ((Prims.snd b)))) +in (let _133_20 = (arg_of_non_null_binder b) +in ((b), (_133_20)))) end else begin -(let _133_16 = (arg_of_non_null_binder b) -in ((b), (_133_16))) +(let _133_21 = (arg_of_non_null_binder b) +in ((b), (_133_21))) end))) -in (FStar_All.pipe_right _133_17 FStar_List.unzip))) +in (FStar_All.pipe_right _133_22 FStar_List.unzip))) let name_binders : FStar_Syntax_Syntax.binder Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list = (fun binders -> (FStar_All.pipe_right binders (FStar_List.mapi (fun i b -> if (FStar_Syntax_Syntax.is_null_binder b) then begin ( -let _38_27 = b -in (match (_38_27) with +let _38_29 = b +in (match (_38_29) with | (a, imp) -> begin ( -let b = (let _133_23 = (let _133_22 = (FStar_Util.string_of_int i) -in (Prims.strcat "_" _133_22)) -in (FStar_Ident.id_of_text _133_23)) +let b = (let _133_28 = (let _133_27 = (FStar_Util.string_of_int i) +in (Prims.strcat "_" _133_27)) +in (FStar_Ident.id_of_text _133_28)) in ( let b = {FStar_Syntax_Syntax.ppname = b; FStar_Syntax_Syntax.index = (Prims.parse_int "0"); FStar_Syntax_Syntax.sort = a.FStar_Syntax_Syntax.sort} @@ -62,33 +66,33 @@ end)))) let name_function_binders = (fun t -> (match (t.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_arrow (binders, comp) -> begin -(let _133_27 = (let _133_26 = (let _133_25 = (name_binders binders) -in ((_133_25), (comp))) -in FStar_Syntax_Syntax.Tm_arrow (_133_26)) -in (FStar_Syntax_Syntax.mk _133_27 None t.FStar_Syntax_Syntax.pos)) +(let _133_32 = (let _133_31 = (let _133_30 = (name_binders binders) +in ((_133_30), (comp))) +in FStar_Syntax_Syntax.Tm_arrow (_133_31)) +in (FStar_Syntax_Syntax.mk _133_32 None t.FStar_Syntax_Syntax.pos)) end -| _38_36 -> begin +| _38_38 -> begin t end)) -let null_binders_of_tks : (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.aqual) Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.aqual) Prims.list = (fun tks -> (FStar_All.pipe_right tks (FStar_List.map (fun _38_40 -> (match (_38_40) with +let null_binders_of_tks : (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.aqual) Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.aqual) Prims.list = (fun tks -> (FStar_All.pipe_right tks (FStar_List.map (fun _38_42 -> (match (_38_42) with | (t, imp) -> begin -(let _133_32 = (let _133_31 = (FStar_Syntax_Syntax.null_binder t) -in (FStar_All.pipe_left Prims.fst _133_31)) -in ((_133_32), (imp))) +(let _133_37 = (let _133_36 = (FStar_Syntax_Syntax.null_binder t) +in (FStar_All.pipe_left Prims.fst _133_36)) +in ((_133_37), (imp))) end))))) -let binders_of_tks : (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.aqual) Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.aqual) Prims.list = (fun tks -> (FStar_All.pipe_right tks (FStar_List.map (fun _38_44 -> (match (_38_44) with +let binders_of_tks : (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.aqual) Prims.list -> (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.aqual) Prims.list = (fun tks -> (FStar_All.pipe_right tks (FStar_List.map (fun _38_46 -> (match (_38_46) with | (t, imp) -> begin -(let _133_36 = (FStar_Syntax_Syntax.new_bv (Some (t.FStar_Syntax_Syntax.pos)) t) -in ((_133_36), (imp))) +(let _133_41 = (FStar_Syntax_Syntax.new_bv (Some (t.FStar_Syntax_Syntax.pos)) t) +in ((_133_41), (imp))) end))))) -let binders_of_freevars : FStar_Syntax_Syntax.bv FStar_Util.set -> FStar_Syntax_Syntax.binder Prims.list = (fun fvs -> (let _133_39 = (FStar_Util.set_elements fvs) -in (FStar_All.pipe_right _133_39 (FStar_List.map FStar_Syntax_Syntax.mk_binder)))) +let binders_of_freevars : FStar_Syntax_Syntax.bv FStar_Util.set -> FStar_Syntax_Syntax.binder Prims.list = (fun fvs -> (let _133_44 = (FStar_Util.set_elements fvs) +in (FStar_All.pipe_right _133_44 (FStar_List.map FStar_Syntax_Syntax.mk_binder)))) let mk_subst = (fun s -> (s)::[]) @@ -102,11 +106,11 @@ end) let rename_binders : FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.subst_t = (fun replace_xs with_ys -> if ((FStar_List.length replace_xs) = (FStar_List.length with_ys)) then begin -(FStar_List.map2 (fun _38_57 _38_61 -> (match (((_38_57), (_38_61))) with -| ((x, _38_56), (y, _38_60)) -> begin -(let _133_55 = (let _133_54 = (FStar_Syntax_Syntax.bv_to_name y) -in ((x), (_133_54))) -in FStar_Syntax_Syntax.NT (_133_55)) +(FStar_List.map2 (fun _38_59 _38_63 -> (match (((_38_59), (_38_63))) with +| ((x, _38_58), (y, _38_62)) -> begin +(let _133_60 = (let _133_59 = (FStar_Syntax_Syntax.bv_to_name y) +in ((x), (_133_59))) +in FStar_Syntax_Syntax.NT (_133_60)) end)) replace_xs with_ys) end else begin (FStar_All.failwith "Ill-formed substitution") @@ -120,7 +124,7 @@ in (match (e.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_meta (e, _)) | (FStar_Syntax_Syntax.Tm_ascribed (e, _, _)) -> begin (unmeta e) end -| _38_76 -> begin +| _38_78 -> begin e end))) @@ -132,22 +136,22 @@ end | FStar_Syntax_Syntax.U_succ (u) -> begin ( -let _38_90 = (univ_kernel u) -in (match (_38_90) with +let _38_92 = (univ_kernel u) +in (match (_38_92) with | (k, n) -> begin ((k), ((n + (Prims.parse_int "1")))) end)) end -| FStar_Syntax_Syntax.U_max (_38_92) -> begin +| FStar_Syntax_Syntax.U_max (_38_94) -> begin (FStar_All.failwith "Imposible: univ_kernel (U_max _)") end -| FStar_Syntax_Syntax.U_bvar (_38_95) -> begin +| FStar_Syntax_Syntax.U_bvar (_38_97) -> begin (FStar_All.failwith "Imposible: univ_kernel (U_bvar _)") end)) -let constant_univ_as_nat : FStar_Syntax_Syntax.universe -> Prims.int = (fun u -> (let _133_62 = (univ_kernel u) -in (Prims.snd _133_62))) +let constant_univ_as_nat : FStar_Syntax_Syntax.universe -> Prims.int = (fun u -> (let _133_67 = (univ_kernel u) +in (Prims.snd _133_67))) let rec compare_univs : FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.universe -> Prims.int = (fun u1 u2 -> (match (((u1), (u2))) with @@ -157,28 +161,28 @@ end | (FStar_Syntax_Syntax.U_unknown, FStar_Syntax_Syntax.U_unknown) -> begin (Prims.parse_int "0") end -| (FStar_Syntax_Syntax.U_unknown, _38_117) -> begin +| (FStar_Syntax_Syntax.U_unknown, _38_119) -> begin (~- ((Prims.parse_int "1"))) end -| (_38_120, FStar_Syntax_Syntax.U_unknown) -> begin +| (_38_122, FStar_Syntax_Syntax.U_unknown) -> begin (Prims.parse_int "1") end | (FStar_Syntax_Syntax.U_zero, FStar_Syntax_Syntax.U_zero) -> begin (Prims.parse_int "0") end -| (FStar_Syntax_Syntax.U_zero, _38_128) -> begin +| (FStar_Syntax_Syntax.U_zero, _38_130) -> begin (~- ((Prims.parse_int "1"))) end -| (_38_131, FStar_Syntax_Syntax.U_zero) -> begin +| (_38_133, FStar_Syntax_Syntax.U_zero) -> begin (Prims.parse_int "1") end | (FStar_Syntax_Syntax.U_name (u1), FStar_Syntax_Syntax.U_name (u2)) -> begin (FStar_String.compare u1.FStar_Ident.idText u2.FStar_Ident.idText) end -| (FStar_Syntax_Syntax.U_name (_38_140), FStar_Syntax_Syntax.U_unif (_38_143)) -> begin +| (FStar_Syntax_Syntax.U_name (_38_142), FStar_Syntax_Syntax.U_unif (_38_145)) -> begin (~- ((Prims.parse_int "1"))) end -| (FStar_Syntax_Syntax.U_unif (_38_147), FStar_Syntax_Syntax.U_name (_38_150)) -> begin +| (FStar_Syntax_Syntax.U_unif (_38_149), FStar_Syntax_Syntax.U_name (_38_152)) -> begin (Prims.parse_int "1") end | (FStar_Syntax_Syntax.U_unif (u1), FStar_Syntax_Syntax.U_unif (u2)) -> begin @@ -196,8 +200,8 @@ in if (n1 <> n2) then begin end else begin ( -let copt = (let _133_68 = (FStar_List.zip us1 us2) -in (FStar_Util.find_map _133_68 (fun _38_167 -> (match (_38_167) with +let copt = (let _133_73 = (FStar_List.zip us1 us2) +in (FStar_Util.find_map _133_73 (fun _38_169 -> (match (_38_169) with | (u1, u2) -> begin ( @@ -217,22 +221,22 @@ c end)) end)) end -| (FStar_Syntax_Syntax.U_max (_38_174), _38_177) -> begin +| (FStar_Syntax_Syntax.U_max (_38_176), _38_179) -> begin (~- ((Prims.parse_int "1"))) end -| (_38_180, FStar_Syntax_Syntax.U_max (_38_182)) -> begin +| (_38_182, FStar_Syntax_Syntax.U_max (_38_184)) -> begin (Prims.parse_int "1") end -| _38_186 -> begin +| _38_188 -> begin ( -let _38_189 = (univ_kernel u1) -in (match (_38_189) with +let _38_191 = (univ_kernel u1) +in (match (_38_191) with | (k1, n1) -> begin ( -let _38_192 = (univ_kernel u2) -in (match (_38_192) with +let _38_194 = (univ_kernel u2) +in (match (_38_194) with | (k2, n2) -> begin ( @@ -260,19 +264,19 @@ end | FStar_Syntax_Syntax.Comp (ct) -> begin ( -let _38_208 = c +let _38_210 = c in {FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Comp (( -let _38_210 = ct -in {FStar_Syntax_Syntax.comp_univs = _38_210.FStar_Syntax_Syntax.comp_univs; FStar_Syntax_Syntax.effect_name = _38_210.FStar_Syntax_Syntax.effect_name; FStar_Syntax_Syntax.result_typ = _38_210.FStar_Syntax_Syntax.result_typ; FStar_Syntax_Syntax.effect_args = _38_210.FStar_Syntax_Syntax.effect_args; FStar_Syntax_Syntax.flags = f})); FStar_Syntax_Syntax.tk = _38_208.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = _38_208.FStar_Syntax_Syntax.pos; FStar_Syntax_Syntax.vars = _38_208.FStar_Syntax_Syntax.vars}) +let _38_212 = ct +in {FStar_Syntax_Syntax.comp_univs = _38_212.FStar_Syntax_Syntax.comp_univs; FStar_Syntax_Syntax.effect_name = _38_212.FStar_Syntax_Syntax.effect_name; FStar_Syntax_Syntax.result_typ = _38_212.FStar_Syntax_Syntax.result_typ; FStar_Syntax_Syntax.effect_args = _38_212.FStar_Syntax_Syntax.effect_args; FStar_Syntax_Syntax.flags = f})); FStar_Syntax_Syntax.tk = _38_210.FStar_Syntax_Syntax.tk; FStar_Syntax_Syntax.pos = _38_210.FStar_Syntax_Syntax.pos; FStar_Syntax_Syntax.vars = _38_210.FStar_Syntax_Syntax.vars}) end)) let comp_flags = (fun c -> (match (c.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (_38_214) -> begin +| FStar_Syntax_Syntax.Total (_38_216) -> begin (FStar_Syntax_Syntax.TOTAL)::[] end -| FStar_Syntax_Syntax.GTotal (_38_217) -> begin +| FStar_Syntax_Syntax.GTotal (_38_219) -> begin (FStar_Syntax_Syntax.SOMETRIVIAL)::[] end | FStar_Syntax_Syntax.Comp (ct) -> begin @@ -284,10 +288,10 @@ let comp_effect_name = (fun c -> (match (c.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Comp (c) -> begin c.FStar_Syntax_Syntax.effect_name end -| FStar_Syntax_Syntax.Total (_38_225) -> begin +| FStar_Syntax_Syntax.Total (_38_227) -> begin FStar_Syntax_Const.effect_Tot_lid end -| FStar_Syntax_Syntax.GTotal (_38_228) -> begin +| FStar_Syntax_Syntax.GTotal (_38_230) -> begin FStar_Syntax_Const.effect_GTot_lid end)) @@ -299,7 +303,7 @@ end | (FStar_Syntax_Syntax.Total (t, Some (u))) | (FStar_Syntax_Syntax.GTotal (t, Some (u))) -> begin {FStar_Syntax_Syntax.comp_univs = (u)::[]; FStar_Syntax_Syntax.effect_name = (comp_effect_name c); FStar_Syntax_Syntax.result_typ = t; FStar_Syntax_Syntax.effect_args = []; FStar_Syntax_Syntax.flags = (comp_flags c)} end -| _38_242 -> begin +| _38_244 -> begin (FStar_All.failwith "Assertion failed: Computation type without universe") end)) @@ -308,7 +312,7 @@ let is_total_comp = (fun c -> (FStar_All.pipe_right (comp_flags c) (FStar_Util.f | (FStar_Syntax_Syntax.TOTAL) | (FStar_Syntax_Syntax.RETURN) -> begin true end -| _38_248 -> begin +| _38_250 -> begin false end))))) @@ -317,7 +321,7 @@ let is_total_lcomp : FStar_Syntax_Syntax.lcomp -> Prims.bool = (fun c -> ((FSt | (FStar_Syntax_Syntax.TOTAL) | (FStar_Syntax_Syntax.RETURN) -> begin true end -| _38_254 -> begin +| _38_256 -> begin false end)))))) @@ -326,7 +330,7 @@ let is_tot_or_gtot_lcomp : FStar_Syntax_Syntax.lcomp -> Prims.bool = (fun c -> | (FStar_Syntax_Syntax.TOTAL) | (FStar_Syntax_Syntax.RETURN) -> begin true end -| _38_260 -> begin +| _38_262 -> begin false end)))))) @@ -335,7 +339,7 @@ let is_partial_return = (fun c -> (FStar_All.pipe_right (comp_flags c) (FStar_Ut | (FStar_Syntax_Syntax.RETURN) | (FStar_Syntax_Syntax.PARTIAL_RETURN) -> begin true end -| _38_266 -> begin +| _38_268 -> begin false end))))) @@ -344,7 +348,7 @@ let is_lcomp_partial_return : FStar_Syntax_Syntax.lcomp -> Prims.bool = (fun c | (FStar_Syntax_Syntax.RETURN) | (FStar_Syntax_Syntax.PARTIAL_RETURN) -> begin true end -| _38_272 -> begin +| _38_274 -> begin false end))))) @@ -356,10 +360,10 @@ let is_pure_effect : FStar_Ident.lident -> Prims.bool = (fun l -> (((FStar_Ide let is_pure_comp = (fun c -> (match (c.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (_38_277) -> begin +| FStar_Syntax_Syntax.Total (_38_279) -> begin true end -| FStar_Syntax_Syntax.GTotal (_38_280) -> begin +| FStar_Syntax_Syntax.GTotal (_38_282) -> begin false end | FStar_Syntax_Syntax.Comp (ct) -> begin @@ -367,7 +371,7 @@ end | FStar_Syntax_Syntax.LEMMA -> begin true end -| _38_287 -> begin +| _38_289 -> begin false end))))) end)) @@ -383,7 +387,7 @@ let is_pure_lcomp : FStar_Syntax_Syntax.lcomp -> Prims.bool = (fun lc -> (((is | FStar_Syntax_Syntax.LEMMA -> begin true end -| _38_294 -> begin +| _38_296 -> begin false end)))))) @@ -391,28 +395,28 @@ end)))))) let is_pure_or_ghost_lcomp : FStar_Syntax_Syntax.lcomp -> Prims.bool = (fun lc -> ((is_pure_lcomp lc) || (is_ghost_effect lc.FStar_Syntax_Syntax.eff_name))) -let is_pure_or_ghost_function : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_113 = (FStar_Syntax_Subst.compress t) -in _133_113.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_arrow (_38_298, c) -> begin +let is_pure_or_ghost_function : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_118 = (FStar_Syntax_Subst.compress t) +in _133_118.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_arrow (_38_300, c) -> begin (is_pure_or_ghost_comp c) end -| _38_303 -> begin +| _38_305 -> begin true end)) -let is_lemma : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_116 = (FStar_Syntax_Subst.compress t) -in _133_116.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_arrow (_38_306, c) -> begin +let is_lemma : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_121 = (FStar_Syntax_Subst.compress t) +in _133_121.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_arrow (_38_308, c) -> begin (match (c.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Comp (ct) -> begin (FStar_Ident.lid_equals ct.FStar_Syntax_Syntax.effect_name FStar_Syntax_Const.effect_Lemma_lid) end -| _38_313 -> begin +| _38_315 -> begin false end) end -| _38_315 -> begin +| _38_317 -> begin false end)) @@ -424,7 +428,7 @@ in (match (t.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_app (head, args) -> begin ((head), (args)) end -| _38_323 -> begin +| _38_325 -> begin ((t), ([])) end))) @@ -433,48 +437,48 @@ let un_uinst : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fun t - let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_uinst (t, _38_328) -> begin +| FStar_Syntax_Syntax.Tm_uinst (t, _38_330) -> begin (FStar_Syntax_Subst.compress t) end -| _38_332 -> begin +| _38_334 -> begin t end))) -let is_smt_lemma : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_123 = (FStar_Syntax_Subst.compress t) -in _133_123.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_arrow (_38_335, c) -> begin +let is_smt_lemma : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_128 = (FStar_Syntax_Subst.compress t) +in _133_128.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_arrow (_38_337, c) -> begin (match (c.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Comp (ct) when (FStar_Ident.lid_equals ct.FStar_Syntax_Syntax.effect_name FStar_Syntax_Const.effect_Lemma_lid) -> begin (match (ct.FStar_Syntax_Syntax.effect_args) with -| (_req)::(_ens)::((pats, _38_345))::_38_342 -> begin +| (_req)::(_ens)::((pats, _38_347))::_38_344 -> begin ( let pats' = (unmeta pats) in ( -let _38_356 = (head_and_args pats') -in (match (_38_356) with -| (head, _38_355) -> begin -(match ((let _133_124 = (un_uinst head) -in _133_124.FStar_Syntax_Syntax.n)) with +let _38_358 = (head_and_args pats') +in (match (_38_358) with +| (head, _38_357) -> begin +(match ((let _133_129 = (un_uinst head) +in _133_129.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.cons_lid) end -| _38_360 -> begin +| _38_362 -> begin false end) end))) end -| _38_362 -> begin +| _38_364 -> begin false end) end -| _38_364 -> begin +| _38_366 -> begin false end) end -| _38_366 -> begin +| _38_368 -> begin false end)) @@ -485,11 +489,11 @@ let is_ml_comp = (fun c -> (match (c.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.MLEFFECT -> begin true end -| _38_373 -> begin +| _38_375 -> begin false end))))) end -| _38_375 -> begin +| _38_377 -> begin false end)) @@ -504,17 +508,17 @@ end)) let set_result_typ = (fun c t -> (match (c.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (_38_391) -> begin +| FStar_Syntax_Syntax.Total (_38_393) -> begin (FStar_Syntax_Syntax.mk_Total t) end -| FStar_Syntax_Syntax.GTotal (_38_394) -> begin +| FStar_Syntax_Syntax.GTotal (_38_396) -> begin (FStar_Syntax_Syntax.mk_GTotal t) end | FStar_Syntax_Syntax.Comp (ct) -> begin (FStar_Syntax_Syntax.mk_Comp ( -let _38_398 = ct -in {FStar_Syntax_Syntax.comp_univs = _38_398.FStar_Syntax_Syntax.comp_univs; FStar_Syntax_Syntax.effect_name = _38_398.FStar_Syntax_Syntax.effect_name; FStar_Syntax_Syntax.result_typ = t; FStar_Syntax_Syntax.effect_args = _38_398.FStar_Syntax_Syntax.effect_args; FStar_Syntax_Syntax.flags = _38_398.FStar_Syntax_Syntax.flags})) +let _38_400 = ct +in {FStar_Syntax_Syntax.comp_univs = _38_400.FStar_Syntax_Syntax.comp_univs; FStar_Syntax_Syntax.effect_name = _38_400.FStar_Syntax_Syntax.effect_name; FStar_Syntax_Syntax.result_typ = t; FStar_Syntax_Syntax.effect_args = _38_400.FStar_Syntax_Syntax.effect_args; FStar_Syntax_Syntax.flags = _38_400.FStar_Syntax_Syntax.flags})) end)) @@ -522,7 +526,7 @@ let is_trivial_wp = (fun c -> (FStar_All.pipe_right (comp_flags c) (FStar_Util.f | (FStar_Syntax_Syntax.TOTAL) | (FStar_Syntax_Syntax.RETURN) -> begin true end -| _38_405 -> begin +| _38_407 -> begin false end))))) @@ -537,7 +541,7 @@ let is_primop = (fun f -> (match (f.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin (is_primop_lid fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) end -| _38_411 -> begin +| _38_413 -> begin false end)) @@ -546,19 +550,19 @@ let rec unascribe : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fu let e = (FStar_Syntax_Subst.compress e) in (match (e.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_ascribed (e, _38_416, _38_418) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (e, _38_418, _38_420) -> begin (unascribe e) end -| _38_422 -> begin +| _38_424 -> begin e end))) let rec ascribe = (fun t k -> (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_ascribed (t', _38_427, _38_429) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (t', _38_429, _38_431) -> begin (ascribe t' k) end -| _38_433 -> begin +| _38_435 -> begin (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_ascribed (((t), (k), (None)))) None t.FStar_Syntax_Syntax.pos) end)) @@ -567,71 +571,71 @@ let rec unrefine : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fun let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_refine (x, _38_438) -> begin +| FStar_Syntax_Syntax.Tm_refine (x, _38_440) -> begin (unrefine x.FStar_Syntax_Syntax.sort) end -| FStar_Syntax_Syntax.Tm_ascribed (t, _38_443, _38_445) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (t, _38_445, _38_447) -> begin (unrefine t) end -| _38_449 -> begin +| _38_451 -> begin t end))) -let rec is_unit : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_143 = (unrefine t) -in _133_143.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_type (_38_452) -> begin +let rec is_unit : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_148 = (unrefine t) +in _133_148.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_type (_38_454) -> begin true end | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin ((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.unit_lid) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.squash_lid)) end -| FStar_Syntax_Syntax.Tm_uinst (t, _38_458) -> begin +| FStar_Syntax_Syntax.Tm_uinst (t, _38_460) -> begin (is_unit t) end -| _38_462 -> begin +| _38_464 -> begin false end)) -let rec non_informative : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_146 = (unrefine t) -in _133_146.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_type (_38_465) -> begin +let rec non_informative : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_151 = (unrefine t) +in _133_151.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_type (_38_467) -> begin true end | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin (((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.unit_lid) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.squash_lid)) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.erased_lid)) end -| FStar_Syntax_Syntax.Tm_app (head, _38_471) -> begin +| FStar_Syntax_Syntax.Tm_app (head, _38_473) -> begin (non_informative head) end -| FStar_Syntax_Syntax.Tm_uinst (t, _38_476) -> begin +| FStar_Syntax_Syntax.Tm_uinst (t, _38_478) -> begin (non_informative t) end -| FStar_Syntax_Syntax.Tm_arrow (_38_480, c) -> begin +| FStar_Syntax_Syntax.Tm_arrow (_38_482, c) -> begin ((is_tot_or_gtot_comp c) && (non_informative (comp_result c))) end -| _38_485 -> begin +| _38_487 -> begin false end)) -let is_fun : FStar_Syntax_Syntax.term -> Prims.bool = (fun e -> (match ((let _133_149 = (FStar_Syntax_Subst.compress e) -in _133_149.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_abs (_38_488) -> begin +let is_fun : FStar_Syntax_Syntax.term -> Prims.bool = (fun e -> (match ((let _133_154 = (FStar_Syntax_Subst.compress e) +in _133_154.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_abs (_38_490) -> begin true end -| _38_491 -> begin +| _38_493 -> begin false end)) -let is_function_typ : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_152 = (FStar_Syntax_Subst.compress t) -in _133_152.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_arrow (_38_494) -> begin +let is_function_typ : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_157 = (FStar_Syntax_Subst.compress t) +in _133_157.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_arrow (_38_496) -> begin true end -| _38_497 -> begin +| _38_499 -> begin false end)) @@ -640,13 +644,13 @@ let rec pre_typ : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fun let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_refine (x, _38_502) -> begin +| FStar_Syntax_Syntax.Tm_refine (x, _38_504) -> begin (pre_typ x.FStar_Syntax_Syntax.sort) end -| FStar_Syntax_Syntax.Tm_ascribed (t, _38_507, _38_509) -> begin +| FStar_Syntax_Syntax.Tm_ascribed (t, _38_509, _38_511) -> begin (pre_typ t) end -| _38_513 -> begin +| _38_515 -> begin t end))) @@ -654,8 +658,8 @@ end))) let destruct : FStar_Syntax_Syntax.term -> FStar_Ident.lident -> FStar_Syntax_Syntax.args Prims.option = (fun typ lid -> ( let typ = (FStar_Syntax_Subst.compress typ) -in (match ((let _133_159 = (un_uinst typ) -in _133_159.FStar_Syntax_Syntax.n)) with +in (match ((let _133_164 = (un_uinst typ) +in _133_164.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_app (head, args) -> begin ( @@ -664,14 +668,14 @@ in (match (head.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_fvar (tc) when (FStar_Syntax_Syntax.fv_eq_lid tc lid) -> begin Some (args) end -| _38_525 -> begin +| _38_527 -> begin None end)) end | FStar_Syntax_Syntax.Tm_fvar (tc) when (FStar_Syntax_Syntax.fv_eq_lid tc lid) -> begin Some ([]) end -| _38_529 -> begin +| _38_531 -> begin None end))) @@ -695,7 +699,7 @@ let lid_of_sigelt : FStar_Syntax_Syntax.sigelt -> FStar_Ident.lident Prims.opt | (l)::[] -> begin Some (l) end -| _38_633 -> begin +| _38_635 -> begin None end)) @@ -716,16 +720,16 @@ end)) let range_of_lb = (fun _38_10 -> (match (_38_10) with -| (FStar_Util.Inl (x), _38_918, _38_920) -> begin +| (FStar_Util.Inl (x), _38_920, _38_922) -> begin (FStar_Syntax_Syntax.range_of_bv x) end -| (FStar_Util.Inr (l), _38_925, _38_927) -> begin +| (FStar_Util.Inr (l), _38_927, _38_929) -> begin (FStar_Ident.range_of_lid l) end)) -let range_of_arg = (fun _38_932 -> (match (_38_932) with -| (hd, _38_931) -> begin +let range_of_arg = (fun _38_934 -> (match (_38_934) with +| (hd, _38_933) -> begin hd.FStar_Syntax_Syntax.pos end)) @@ -741,16 +745,16 @@ in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (((f), (args)))) None r)) let mk_data = (fun l args -> (match (args) with | [] -> begin -(let _133_180 = (let _133_179 = (let _133_178 = (FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) -in ((_133_178), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app)))) -in FStar_Syntax_Syntax.Tm_meta (_133_179)) -in (FStar_Syntax_Syntax.mk _133_180 None (FStar_Ident.range_of_lid l))) +(let _133_185 = (let _133_184 = (let _133_183 = (FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) +in ((_133_183), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app)))) +in FStar_Syntax_Syntax.Tm_meta (_133_184)) +in (FStar_Syntax_Syntax.mk _133_185 None (FStar_Ident.range_of_lid l))) end -| _38_944 -> begin +| _38_946 -> begin ( -let e = (let _133_181 = (FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) -in (mk_app _133_181 args)) +let e = (let _133_186 = (FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (Some (FStar_Syntax_Syntax.Data_ctor))) +in (mk_app _133_186 args)) in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (((e), (FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Data_app))))) None e.FStar_Syntax_Syntax.pos)) end)) @@ -759,22 +763,50 @@ let mangle_field_name : FStar_Ident.ident -> FStar_Ident.ident = (fun x -> (FS let unmangle_field_name : FStar_Ident.ident -> FStar_Ident.ident = (fun x -> if (FStar_Util.starts_with x.FStar_Ident.idText "^fname^") then begin -(let _133_187 = (let _133_186 = (FStar_Util.substring_from x.FStar_Ident.idText (Prims.parse_int "7")) -in ((_133_186), (x.FStar_Ident.idRange))) -in (FStar_Ident.mk_ident _133_187)) +(let _133_192 = (let _133_191 = (FStar_Util.substring_from x.FStar_Ident.idText (Prims.parse_int "7")) +in ((_133_191), (x.FStar_Ident.idRange))) +in (FStar_Ident.mk_ident _133_192)) end else begin x end) +let field_projector_prefix : Prims.string = "__proj__" + + +let field_projector_sep : Prims.string = "__item__" + + +let field_projector_contains_constructor : Prims.string -> Prims.bool = (fun s -> (FStar_Util.starts_with s field_projector_prefix)) + + +let mk_field_projector_name_from_string : Prims.string -> Prims.string -> Prims.string = (fun constr field -> (Prims.strcat field_projector_prefix (Prims.strcat constr (Prims.strcat field_projector_sep field)))) + + +let mk_field_projector_name_from_ident : FStar_Ident.lident -> FStar_Ident.ident -> FStar_Ident.lident = (fun lid i -> ( + +let j = (unmangle_field_name i) +in ( + +let jtext = j.FStar_Ident.idText +in ( + +let newi = if (field_projector_contains_constructor jtext) then begin +j +end else begin +(FStar_Ident.mk_ident (((mk_field_projector_name_from_string lid.FStar_Ident.ident.FStar_Ident.idText jtext)), (i.FStar_Ident.idRange))) +end +in (FStar_Ident.lid_of_ids (FStar_List.append lid.FStar_Ident.ns ((newi)::[]))))))) + + let mk_field_projector_name : FStar_Ident.lident -> FStar_Syntax_Syntax.bv -> Prims.int -> (FStar_Ident.lident * FStar_Syntax_Syntax.bv) = (fun lid x i -> ( let nm = if (FStar_Syntax_Syntax.is_null_bv x) then begin -(let _133_197 = (let _133_196 = (let _133_194 = (FStar_Util.string_of_int i) -in (Prims.strcat "_" _133_194)) -in (let _133_195 = (FStar_Syntax_Syntax.range_of_bv x) -in ((_133_196), (_133_195)))) -in (FStar_Ident.mk_ident _133_197)) +(let _133_212 = (let _133_211 = (let _133_209 = (FStar_Util.string_of_int i) +in (Prims.strcat "_" _133_209)) +in (let _133_210 = (FStar_Syntax_Syntax.range_of_bv x) +in ((_133_211), (_133_210)))) +in (FStar_Ident.mk_ident _133_212)) end else begin x.FStar_Syntax_Syntax.ppname end @@ -782,23 +814,20 @@ in ( let y = ( -let _38_952 = x -in {FStar_Syntax_Syntax.ppname = nm; FStar_Syntax_Syntax.index = _38_952.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _38_952.FStar_Syntax_Syntax.sort}) -in (let _133_201 = (let _133_200 = (let _133_199 = (let _133_198 = (unmangle_field_name nm) -in (_133_198)::[]) -in (FStar_List.append (FStar_Ident.ids_of_lid lid) _133_199)) -in (FStar_Ident.lid_of_ids _133_200)) -in ((_133_201), (y)))))) +let _38_962 = x +in {FStar_Syntax_Syntax.ppname = nm; FStar_Syntax_Syntax.index = _38_962.FStar_Syntax_Syntax.index; FStar_Syntax_Syntax.sort = _38_962.FStar_Syntax_Syntax.sort}) +in (let _133_213 = (mk_field_projector_name_from_ident lid nm) +in ((_133_213), (y)))))) let set_uvar = (fun uv t -> (match ((FStar_Unionfind.find uv)) with -| FStar_Syntax_Syntax.Fixed (_38_958) -> begin -(let _133_206 = (let _133_205 = (let _133_204 = (FStar_Unionfind.uvar_id uv) -in (FStar_All.pipe_left FStar_Util.string_of_int _133_204)) -in (FStar_Util.format1 "Changing a fixed uvar! ?%s\n" _133_205)) -in (FStar_All.failwith _133_206)) +| FStar_Syntax_Syntax.Fixed (_38_968) -> begin +(let _133_218 = (let _133_217 = (let _133_216 = (FStar_Unionfind.uvar_id uv) +in (FStar_All.pipe_left FStar_Util.string_of_int _133_216)) +in (FStar_Util.format1 "Changing a fixed uvar! ?%s\n" _133_217)) +in (FStar_All.failwith _133_218)) end -| _38_961 -> begin +| _38_971 -> begin (FStar_Unionfind.change uv (FStar_Syntax_Syntax.Fixed (t))) end)) @@ -813,7 +842,7 @@ end | ((FStar_Syntax_Syntax.RecordType (f1), FStar_Syntax_Syntax.RecordType (f2))) | ((FStar_Syntax_Syntax.RecordConstructor (f1), FStar_Syntax_Syntax.RecordConstructor (f2))) -> begin (((FStar_List.length f1) = (FStar_List.length f2)) && (FStar_List.forall2 FStar_Ident.lid_equals f1 f2)) end -| _38_987 -> begin +| _38_997 -> begin (q1 = q2) end)) @@ -828,29 +857,29 @@ let close_lopt = (fun lopt -> (match (lopt) with lopt end | Some (FStar_Util.Inl (lc)) -> begin -(let _133_220 = (let _133_219 = (FStar_Syntax_Subst.close_lcomp bs lc) -in FStar_Util.Inl (_133_219)) -in Some (_133_220)) +(let _133_232 = (let _133_231 = (FStar_Syntax_Subst.close_lcomp bs lc) +in FStar_Util.Inl (_133_231)) +in Some (_133_232)) end)) in (match (bs) with | [] -> begin t end -| _38_1003 -> begin +| _38_1013 -> begin ( -let body = (let _133_221 = (FStar_Syntax_Subst.close bs t) -in (FStar_Syntax_Subst.compress _133_221)) +let body = (let _133_233 = (FStar_Syntax_Subst.close bs t) +in (FStar_Syntax_Subst.compress _133_233)) in (match (((body.FStar_Syntax_Syntax.n), (lopt))) with | (FStar_Syntax_Syntax.Tm_abs (bs', t, lopt'), None) -> begin -(let _133_226 = (let _133_225 = (let _133_224 = (let _133_222 = (FStar_Syntax_Subst.close_binders bs) -in (FStar_List.append _133_222 bs')) -in (let _133_223 = (close_lopt lopt') -in ((_133_224), (t), (_133_223)))) -in FStar_Syntax_Syntax.Tm_abs (_133_225)) -in (FStar_Syntax_Syntax.mk _133_226 None t.FStar_Syntax_Syntax.pos)) -end -| _38_1013 -> begin +(let _133_238 = (let _133_237 = (let _133_236 = (let _133_234 = (FStar_Syntax_Subst.close_binders bs) +in (FStar_List.append _133_234 bs')) +in (let _133_235 = (close_lopt lopt') +in ((_133_236), (t), (_133_235)))) +in FStar_Syntax_Syntax.Tm_abs (_133_237)) +in (FStar_Syntax_Syntax.mk _133_238 None t.FStar_Syntax_Syntax.pos)) +end +| _38_1023 -> begin ( let lopt = (match (lopt) with @@ -858,14 +887,14 @@ let lopt = (match (lopt) with lopt end | Some (FStar_Util.Inl (lc)) -> begin -(let _133_228 = (let _133_227 = (FStar_Syntax_Subst.close_lcomp bs lc) -in FStar_Util.Inl (_133_227)) -in Some (_133_228)) +(let _133_240 = (let _133_239 = (FStar_Syntax_Subst.close_lcomp bs lc) +in FStar_Util.Inl (_133_239)) +in Some (_133_240)) end) -in (let _133_231 = (let _133_230 = (let _133_229 = (FStar_Syntax_Subst.close_binders bs) -in ((_133_229), (body), (lopt))) -in FStar_Syntax_Syntax.Tm_abs (_133_230)) -in (FStar_Syntax_Syntax.mk _133_231 None t.FStar_Syntax_Syntax.pos))) +in (let _133_243 = (let _133_242 = (let _133_241 = (FStar_Syntax_Subst.close_binders bs) +in ((_133_241), (body), (lopt))) +in FStar_Syntax_Syntax.Tm_abs (_133_242)) +in (FStar_Syntax_Syntax.mk _133_243 None t.FStar_Syntax_Syntax.pos))) end)) end)) end) @@ -875,51 +904,51 @@ let arrow : (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.op | [] -> begin (comp_result c) end -| _38_1027 -> begin -(let _133_239 = (let _133_238 = (let _133_237 = (FStar_Syntax_Subst.close_binders bs) -in (let _133_236 = (FStar_Syntax_Subst.close_comp bs c) -in ((_133_237), (_133_236)))) -in FStar_Syntax_Syntax.Tm_arrow (_133_238)) -in (FStar_Syntax_Syntax.mk _133_239 None c.FStar_Syntax_Syntax.pos)) +| _38_1037 -> begin +(let _133_251 = (let _133_250 = (let _133_249 = (FStar_Syntax_Subst.close_binders bs) +in (let _133_248 = (FStar_Syntax_Subst.close_comp bs c) +in ((_133_249), (_133_248)))) +in FStar_Syntax_Syntax.Tm_arrow (_133_250)) +in (FStar_Syntax_Syntax.mk _133_251 None c.FStar_Syntax_Syntax.pos)) end)) let flat_arrow : (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list -> (FStar_Syntax_Syntax.comp', Prims.unit) FStar_Syntax_Syntax.syntax -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun bs c -> ( let t = (arrow bs c) -in (match ((let _133_244 = (FStar_Syntax_Subst.compress t) -in _133_244.FStar_Syntax_Syntax.n)) with +in (match ((let _133_256 = (FStar_Syntax_Subst.compress t) +in _133_256.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_arrow (bs, c) -> begin (match (c.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (tres, _38_1037) -> begin -(match ((let _133_245 = (FStar_Syntax_Subst.compress tres) -in _133_245.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Total (tres, _38_1047) -> begin +(match ((let _133_257 = (FStar_Syntax_Subst.compress tres) +in _133_257.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_arrow (bs', c') -> begin -(let _133_246 = (FStar_ST.read t.FStar_Syntax_Syntax.tk) -in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow ((((FStar_List.append bs bs')), (c')))) _133_246 t.FStar_Syntax_Syntax.pos)) +(let _133_258 = (FStar_ST.read t.FStar_Syntax_Syntax.tk) +in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow ((((FStar_List.append bs bs')), (c')))) _133_258 t.FStar_Syntax_Syntax.pos)) end -| _38_1045 -> begin +| _38_1055 -> begin t end) end -| _38_1047 -> begin +| _38_1057 -> begin t end) end -| _38_1049 -> begin +| _38_1059 -> begin t end))) -let refine : FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun b t -> (let _133_258 = (let _133_254 = (let _133_253 = (let _133_252 = (let _133_251 = (FStar_Syntax_Syntax.mk_binder b) -in (_133_251)::[]) -in (FStar_Syntax_Subst.close _133_252 t)) -in ((b), (_133_253))) -in FStar_Syntax_Syntax.Tm_refine (_133_254)) -in (let _133_257 = (FStar_ST.read b.FStar_Syntax_Syntax.sort.FStar_Syntax_Syntax.tk) -in (let _133_256 = (let _133_255 = (FStar_Syntax_Syntax.range_of_bv b) -in (FStar_Range.union_ranges _133_255 t.FStar_Syntax_Syntax.pos)) -in (FStar_Syntax_Syntax.mk _133_258 _133_257 _133_256))))) +let refine : FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun b t -> (let _133_270 = (let _133_266 = (let _133_265 = (let _133_264 = (let _133_263 = (FStar_Syntax_Syntax.mk_binder b) +in (_133_263)::[]) +in (FStar_Syntax_Subst.close _133_264 t)) +in ((b), (_133_265))) +in FStar_Syntax_Syntax.Tm_refine (_133_266)) +in (let _133_269 = (FStar_ST.read b.FStar_Syntax_Syntax.sort.FStar_Syntax_Syntax.tk) +in (let _133_268 = (let _133_267 = (FStar_Syntax_Syntax.range_of_bv b) +in (FStar_Range.union_ranges _133_267 t.FStar_Syntax_Syntax.pos)) +in (FStar_Syntax_Syntax.mk _133_270 _133_269 _133_268))))) let branch : FStar_Syntax_Syntax.branch -> FStar_Syntax_Syntax.branch = (fun b -> (FStar_Syntax_Subst.close_branch b)) @@ -932,14 +961,14 @@ in (match (k.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_arrow (bs, c) -> begin ( -let _38_1061 = (FStar_Syntax_Subst.open_comp bs c) -in (match (_38_1061) with +let _38_1071 = (FStar_Syntax_Subst.open_comp bs c) +in (match (_38_1071) with | (bs, c) -> begin if (is_tot_or_gtot_comp c) then begin ( -let _38_1064 = (arrow_formals_comp (comp_result c)) -in (match (_38_1064) with +let _38_1074 = (arrow_formals_comp (comp_result c)) +in (match (_38_1074) with | (bs', k) -> begin (((FStar_List.append bs bs')), (k)) end)) @@ -948,16 +977,16 @@ end else begin end end)) end -| _38_1066 -> begin -(let _133_263 = (FStar_Syntax_Syntax.mk_Total k) -in (([]), (_133_263))) +| _38_1076 -> begin +(let _133_275 = (FStar_Syntax_Syntax.mk_Total k) +in (([]), (_133_275))) end))) let rec arrow_formals : FStar_Syntax_Syntax.term -> ((FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.arg_qualifier Prims.option) Prims.list * FStar_Syntax_Syntax.typ) = (fun k -> ( -let _38_1070 = (arrow_formals_comp k) -in (match (_38_1070) with +let _38_1080 = (arrow_formals_comp k) +in (match (_38_1080) with | (bs, c) -> begin ((bs), ((comp_result c))) end))) @@ -965,30 +994,30 @@ end))) let abs_formals : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binders * FStar_Syntax_Syntax.term * (FStar_Syntax_Syntax.lcomp, FStar_Ident.lident) FStar_Util.either Prims.option) = (fun t -> ( -let rec aux = (fun t what -> (match ((let _133_273 = (let _133_272 = (FStar_Syntax_Subst.compress t) -in (FStar_All.pipe_left unascribe _133_272)) -in _133_273.FStar_Syntax_Syntax.n)) with +let rec aux = (fun t what -> (match ((let _133_285 = (let _133_284 = (FStar_Syntax_Subst.compress t) +in (FStar_All.pipe_left unascribe _133_284)) +in _133_285.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_abs (bs, t, what) -> begin ( -let _38_1083 = (aux t what) -in (match (_38_1083) with +let _38_1093 = (aux t what) +in (match (_38_1093) with | (bs', t, what) -> begin (((FStar_List.append bs bs')), (t), (what)) end)) end -| _38_1085 -> begin +| _38_1095 -> begin (([]), (t), (what)) end)) in ( -let _38_1089 = (aux t None) -in (match (_38_1089) with +let _38_1099 = (aux t None) +in (match (_38_1099) with | (bs, t, what) -> begin ( -let _38_1092 = (FStar_Syntax_Subst.open_term bs t) -in (match (_38_1092) with +let _38_1102 = (FStar_Syntax_Subst.open_term bs t) +in (match (_38_1102) with | (bs, t) -> begin ((bs), (t), (what)) end)) @@ -1004,10 +1033,10 @@ let def = (match (((recs), (univ_vars))) with | ((None, _)) | ((_, [])) -> begin def end -| (Some (fvs), _38_1115) -> begin +| (Some (fvs), _38_1125) -> begin ( -let universes = (FStar_All.pipe_right univ_vars (FStar_List.map (fun _133_296 -> FStar_Syntax_Syntax.U_name (_133_296)))) +let universes = (FStar_All.pipe_right univ_vars (FStar_List.map (fun _133_308 -> FStar_Syntax_Syntax.U_name (_133_308)))) in ( let inst = (FStar_All.pipe_right fvs (FStar_List.map (fun fv -> ((fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v), (universes))))) @@ -1026,27 +1055,27 @@ let open_univ_vars_binders_and_comp : FStar_Syntax_Syntax.univ_names -> (FStar | [] -> begin ( -let _38_1129 = (FStar_Syntax_Subst.open_univ_vars_comp uvs c) -in (match (_38_1129) with +let _38_1139 = (FStar_Syntax_Subst.open_univ_vars_comp uvs c) +in (match (_38_1139) with | (uvs, c) -> begin ((uvs), ([]), (c)) end)) end -| _38_1131 -> begin +| _38_1141 -> begin ( let t' = (arrow binders c) in ( -let _38_1135 = (FStar_Syntax_Subst.open_univ_vars uvs t') -in (match (_38_1135) with +let _38_1145 = (FStar_Syntax_Subst.open_univ_vars uvs t') +in (match (_38_1145) with | (uvs, t') -> begin -(match ((let _133_304 = (FStar_Syntax_Subst.compress t') -in _133_304.FStar_Syntax_Syntax.n)) with +(match ((let _133_316 = (FStar_Syntax_Subst.compress t') +in _133_316.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_arrow (binders, c) -> begin ((uvs), (binders), (c)) end -| _38_1141 -> begin +| _38_1151 -> begin (FStar_All.failwith "Impossible") end) end))) @@ -1057,54 +1086,54 @@ let is_tuple_constructor : FStar_Syntax_Syntax.typ -> Prims.bool = (fun t -> ( | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin (FStar_Util.starts_with fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v.FStar_Ident.str "Prims.tuple") end -| _38_1146 -> begin +| _38_1156 -> begin false end)) let mk_tuple_lid : Prims.int -> FStar_Range.range -> FStar_Ident.lident = (fun n r -> ( -let t = (let _133_311 = (FStar_Util.string_of_int n) -in (FStar_Util.format1 "tuple%s" _133_311)) -in (let _133_312 = (FStar_Syntax_Const.pconst t) -in (FStar_Ident.set_lid_range _133_312 r)))) +let t = (let _133_323 = (FStar_Util.string_of_int n) +in (FStar_Util.format1 "tuple%s" _133_323)) +in (let _133_324 = (FStar_Syntax_Const.pconst t) +in (FStar_Ident.set_lid_range _133_324 r)))) let mk_tuple_data_lid : Prims.int -> FStar_Range.range -> FStar_Ident.lident = (fun n r -> ( -let t = (let _133_317 = (FStar_Util.string_of_int n) -in (FStar_Util.format1 "Mktuple%s" _133_317)) -in (let _133_318 = (FStar_Syntax_Const.pconst t) -in (FStar_Ident.set_lid_range _133_318 r)))) +let t = (let _133_329 = (FStar_Util.string_of_int n) +in (FStar_Util.format1 "Mktuple%s" _133_329)) +in (let _133_330 = (FStar_Syntax_Const.pconst t) +in (FStar_Ident.set_lid_range _133_330 r)))) -let is_tuple_data_lid : FStar_Ident.lident -> Prims.int -> Prims.bool = (fun f n -> (let _133_323 = (mk_tuple_data_lid n FStar_Range.dummyRange) -in (FStar_Ident.lid_equals f _133_323))) +let is_tuple_data_lid : FStar_Ident.lident -> Prims.int -> Prims.bool = (fun f n -> (let _133_335 = (mk_tuple_data_lid n FStar_Range.dummyRange) +in (FStar_Ident.lid_equals f _133_335))) let is_dtuple_constructor : FStar_Syntax_Syntax.typ -> Prims.bool = (fun t -> (match (t.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin (FStar_Util.starts_with fv.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v.FStar_Ident.str "Prims.dtuple") end -| _38_1159 -> begin +| _38_1169 -> begin false end)) let mk_dtuple_lid : Prims.int -> FStar_Range.range -> FStar_Ident.lident = (fun n r -> ( -let t = (let _133_330 = (FStar_Util.string_of_int n) -in (FStar_Util.format1 "dtuple%s" _133_330)) -in (let _133_331 = (FStar_Syntax_Const.pconst t) -in (FStar_Ident.set_lid_range _133_331 r)))) +let t = (let _133_342 = (FStar_Util.string_of_int n) +in (FStar_Util.format1 "dtuple%s" _133_342)) +in (let _133_343 = (FStar_Syntax_Const.pconst t) +in (FStar_Ident.set_lid_range _133_343 r)))) let mk_dtuple_data_lid : Prims.int -> FStar_Range.range -> FStar_Ident.lident = (fun n r -> ( -let t = (let _133_336 = (FStar_Util.string_of_int n) -in (FStar_Util.format1 "Mkdtuple%s" _133_336)) -in (let _133_337 = (FStar_Syntax_Const.pconst t) -in (FStar_Ident.set_lid_range _133_337 r)))) +let t = (let _133_348 = (FStar_Util.string_of_int n) +in (FStar_Util.format1 "Mkdtuple%s" _133_348)) +in (let _133_349 = (FStar_Syntax_Const.pconst t) +in (FStar_Ident.set_lid_range _133_349 r)))) let is_lid_equality : FStar_Ident.lident -> Prims.bool = (fun x -> (FStar_Ident.lid_equals x FStar_Syntax_Const.eq2_lid)) @@ -1128,25 +1157,25 @@ let lst = (FStar_Syntax_Const.and_lid)::(FStar_Syntax_Const.or_lid)::(FStar_Synt in (fun lid -> (FStar_Util.for_some (FStar_Ident.lid_equals lid) lst))) -let is_constructor : FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = (fun t lid -> (match ((let _133_353 = (pre_typ t) -in _133_353.FStar_Syntax_Syntax.n)) with +let is_constructor : FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = (fun t lid -> (match ((let _133_365 = (pre_typ t) +in _133_365.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_fvar (tc) -> begin (FStar_Ident.lid_equals tc.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v lid) end -| _38_1178 -> begin +| _38_1188 -> begin false end)) -let rec is_constructed_typ : FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = (fun t lid -> (match ((let _133_358 = (pre_typ t) -in _133_358.FStar_Syntax_Syntax.n)) with -| FStar_Syntax_Syntax.Tm_fvar (_38_1182) -> begin +let rec is_constructed_typ : FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = (fun t lid -> (match ((let _133_370 = (pre_typ t) +in _133_370.FStar_Syntax_Syntax.n)) with +| FStar_Syntax_Syntax.Tm_fvar (_38_1192) -> begin (is_constructor t lid) end -| FStar_Syntax_Syntax.Tm_app (t, _38_1186) -> begin +| FStar_Syntax_Syntax.Tm_app (t, _38_1196) -> begin (is_constructed_typ t lid) end -| _38_1190 -> begin +| _38_1200 -> begin false end)) @@ -1158,16 +1187,16 @@ in (match (t.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_bvar (_)) | (FStar_Syntax_Syntax.Tm_name (_)) | (FStar_Syntax_Syntax.Tm_fvar (_)) -> begin Some (t) end -| FStar_Syntax_Syntax.Tm_app (t, _38_1204) -> begin +| FStar_Syntax_Syntax.Tm_app (t, _38_1214) -> begin (get_tycon t) end -| _38_1208 -> begin +| _38_1218 -> begin None end))) -let sortByFieldName = (fun fn_a_l -> (FStar_All.pipe_right fn_a_l (FStar_List.sortWith (fun _38_1214 _38_1218 -> (match (((_38_1214), (_38_1218))) with -| ((fn1, _38_1213), (fn2, _38_1217)) -> begin +let sortByFieldName = (fun fn_a_l -> (FStar_All.pipe_right fn_a_l (FStar_List.sortWith (fun _38_1224 _38_1228 -> (match (((_38_1224), (_38_1228))) with +| ((fn1, _38_1223), (fn2, _38_1227)) -> begin (FStar_String.compare (FStar_Ident.text_of_lid fn1) (FStar_Ident.text_of_lid fn2)) end))))) @@ -1184,14 +1213,14 @@ let ktype : (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_ let ktype0 : (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type (FStar_Syntax_Syntax.U_zero)) None FStar_Range.dummyRange) -let type_u : Prims.unit -> (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.universe) = (fun _38_1221 -> (match (()) with +let type_u : Prims.unit -> (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.universe) = (fun _38_1231 -> (match (()) with | () -> begin ( -let u = (let _133_369 = (FStar_Unionfind.fresh None) -in (FStar_All.pipe_left (fun _133_368 -> FStar_Syntax_Syntax.U_unif (_133_368)) _133_369)) -in (let _133_370 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type (u)) None FStar_Range.dummyRange) -in ((_133_370), (u)))) +let u = (let _133_381 = (FStar_Unionfind.fresh None) +in (FStar_All.pipe_left (fun _133_380 -> FStar_Syntax_Syntax.U_unif (_133_380)) _133_381)) +in (let _133_382 = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type (u)) None FStar_Range.dummyRange) +in ((_133_382), (u)))) end)) @@ -1236,33 +1265,33 @@ let mk_conj_opt : FStar_Syntax_Syntax.term Prims.option -> FStar_Syntax_Syntax Some (phi2) end | Some (phi1) -> begin -(let _133_384 = (let _133_383 = (let _133_381 = (let _133_380 = (let _133_379 = (FStar_Syntax_Syntax.as_arg phi1) -in (let _133_378 = (let _133_377 = (FStar_Syntax_Syntax.as_arg phi2) -in (_133_377)::[]) -in (_133_379)::_133_378)) -in ((tand), (_133_380))) -in FStar_Syntax_Syntax.Tm_app (_133_381)) -in (let _133_382 = (FStar_Range.union_ranges phi1.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos) -in (FStar_Syntax_Syntax.mk _133_383 None _133_382))) -in Some (_133_384)) +(let _133_396 = (let _133_395 = (let _133_393 = (let _133_392 = (let _133_391 = (FStar_Syntax_Syntax.as_arg phi1) +in (let _133_390 = (let _133_389 = (FStar_Syntax_Syntax.as_arg phi2) +in (_133_389)::[]) +in (_133_391)::_133_390)) +in ((tand), (_133_392))) +in FStar_Syntax_Syntax.Tm_app (_133_393)) +in (let _133_394 = (FStar_Range.union_ranges phi1.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos) +in (FStar_Syntax_Syntax.mk _133_395 None _133_394))) +in Some (_133_396)) end)) -let mk_binop = (fun op_t phi1 phi2 -> (let _133_394 = (let _133_392 = (let _133_391 = (let _133_390 = (FStar_Syntax_Syntax.as_arg phi1) -in (let _133_389 = (let _133_388 = (FStar_Syntax_Syntax.as_arg phi2) -in (_133_388)::[]) -in (_133_390)::_133_389)) -in ((op_t), (_133_391))) -in FStar_Syntax_Syntax.Tm_app (_133_392)) -in (let _133_393 = (FStar_Range.union_ranges phi1.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos) -in (FStar_Syntax_Syntax.mk _133_394 None _133_393)))) +let mk_binop = (fun op_t phi1 phi2 -> (let _133_406 = (let _133_404 = (let _133_403 = (let _133_402 = (FStar_Syntax_Syntax.as_arg phi1) +in (let _133_401 = (let _133_400 = (FStar_Syntax_Syntax.as_arg phi2) +in (_133_400)::[]) +in (_133_402)::_133_401)) +in ((op_t), (_133_403))) +in FStar_Syntax_Syntax.Tm_app (_133_404)) +in (let _133_405 = (FStar_Range.union_ranges phi1.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos) +in (FStar_Syntax_Syntax.mk _133_406 None _133_405)))) -let mk_neg = (fun phi -> (let _133_399 = (let _133_398 = (let _133_397 = (let _133_396 = (FStar_Syntax_Syntax.as_arg phi) -in (_133_396)::[]) -in ((t_not), (_133_397))) -in FStar_Syntax_Syntax.Tm_app (_133_398)) -in (FStar_Syntax_Syntax.mk _133_399 None phi.FStar_Syntax_Syntax.pos))) +let mk_neg = (fun phi -> (let _133_411 = (let _133_410 = (let _133_409 = (let _133_408 = (FStar_Syntax_Syntax.as_arg phi) +in (_133_408)::[]) +in ((t_not), (_133_409))) +in FStar_Syntax_Syntax.Tm_app (_133_410)) +in (FStar_Syntax_Syntax.mk _133_411 None phi.FStar_Syntax_Syntax.pos))) let mk_conj = (fun phi1 phi2 -> (mk_binop tand phi1 phi2)) @@ -1289,21 +1318,21 @@ end end)) -let mk_imp : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fun phi1 phi2 -> (match ((let _133_412 = (FStar_Syntax_Subst.compress phi1) -in _133_412.FStar_Syntax_Syntax.n)) with +let mk_imp : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = (fun phi1 phi2 -> (match ((let _133_424 = (FStar_Syntax_Subst.compress phi1) +in _133_424.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_fvar (tc) when (FStar_Syntax_Syntax.fv_eq_lid tc FStar_Syntax_Const.false_lid) -> begin t_true end | FStar_Syntax_Syntax.Tm_fvar (tc) when (FStar_Syntax_Syntax.fv_eq_lid tc FStar_Syntax_Const.true_lid) -> begin phi2 end -| _38_1254 -> begin -(match ((let _133_413 = (FStar_Syntax_Subst.compress phi2) -in _133_413.FStar_Syntax_Syntax.n)) with +| _38_1264 -> begin +(match ((let _133_425 = (FStar_Syntax_Subst.compress phi2) +in _133_425.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_fvar (tc) when ((FStar_Syntax_Syntax.fv_eq_lid tc FStar_Syntax_Const.true_lid) || (FStar_Syntax_Syntax.fv_eq_lid tc FStar_Syntax_Const.false_lid)) -> begin phi2 end -| _38_1258 -> begin +| _38_1268 -> begin (mk_binop timp phi1 phi2) end) end)) @@ -1312,24 +1341,24 @@ end)) let mk_iff = (fun phi1 phi2 -> (mk_binop tiff phi1 phi2)) -let b2t = (fun e -> (let _133_420 = (let _133_419 = (let _133_418 = (let _133_417 = (FStar_Syntax_Syntax.as_arg e) -in (_133_417)::[]) -in ((b2t_v), (_133_418))) -in FStar_Syntax_Syntax.Tm_app (_133_419)) -in (FStar_Syntax_Syntax.mk _133_420 None e.FStar_Syntax_Syntax.pos))) +let b2t = (fun e -> (let _133_432 = (let _133_431 = (let _133_430 = (let _133_429 = (FStar_Syntax_Syntax.as_arg e) +in (_133_429)::[]) +in ((b2t_v), (_133_430))) +in FStar_Syntax_Syntax.Tm_app (_133_431)) +in (FStar_Syntax_Syntax.mk _133_432 None e.FStar_Syntax_Syntax.pos))) let teq : FStar_Syntax_Syntax.term = (fvar_const FStar_Syntax_Const.eq2_lid) -let mk_eq = (fun t1 t2 e1 e2 -> (let _133_431 = (let _133_429 = (let _133_428 = (let _133_427 = (FStar_Syntax_Syntax.as_arg e1) -in (let _133_426 = (let _133_425 = (FStar_Syntax_Syntax.as_arg e2) -in (_133_425)::[]) -in (_133_427)::_133_426)) -in ((teq), (_133_428))) -in FStar_Syntax_Syntax.Tm_app (_133_429)) -in (let _133_430 = (FStar_Range.union_ranges e1.FStar_Syntax_Syntax.pos e2.FStar_Syntax_Syntax.pos) -in (FStar_Syntax_Syntax.mk _133_431 None _133_430)))) +let mk_eq = (fun t1 t2 e1 e2 -> (let _133_443 = (let _133_441 = (let _133_440 = (let _133_439 = (FStar_Syntax_Syntax.as_arg e1) +in (let _133_438 = (let _133_437 = (FStar_Syntax_Syntax.as_arg e2) +in (_133_437)::[]) +in (_133_439)::_133_438)) +in ((teq), (_133_440))) +in FStar_Syntax_Syntax.Tm_app (_133_441)) +in (let _133_442 = (FStar_Range.union_ranges e1.FStar_Syntax_Syntax.pos e2.FStar_Syntax_Syntax.pos) +in (FStar_Syntax_Syntax.mk _133_443 None _133_442)))) let mk_has_type = (fun t x t' -> ( @@ -1338,15 +1367,15 @@ let t_has_type = (fvar_const FStar_Syntax_Const.has_type_lid) in ( let t_has_type = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_uinst (((t_has_type), ((FStar_Syntax_Syntax.U_zero)::(FStar_Syntax_Syntax.U_zero)::[])))) None FStar_Range.dummyRange) -in (let _133_442 = (let _133_441 = (let _133_440 = (let _133_439 = (FStar_Syntax_Syntax.iarg t) -in (let _133_438 = (let _133_437 = (FStar_Syntax_Syntax.as_arg x) -in (let _133_436 = (let _133_435 = (FStar_Syntax_Syntax.as_arg t') -in (_133_435)::[]) -in (_133_437)::_133_436)) -in (_133_439)::_133_438)) -in ((t_has_type), (_133_440))) -in FStar_Syntax_Syntax.Tm_app (_133_441)) -in (FStar_Syntax_Syntax.mk _133_442 None FStar_Range.dummyRange))))) +in (let _133_454 = (let _133_453 = (let _133_452 = (let _133_451 = (FStar_Syntax_Syntax.iarg t) +in (let _133_450 = (let _133_449 = (FStar_Syntax_Syntax.as_arg x) +in (let _133_448 = (let _133_447 = (FStar_Syntax_Syntax.as_arg t') +in (_133_447)::[]) +in (_133_449)::_133_448)) +in (_133_451)::_133_450)) +in ((t_has_type), (_133_452))) +in FStar_Syntax_Syntax.Tm_app (_133_453)) +in (FStar_Syntax_Syntax.mk _133_454 None FStar_Range.dummyRange))))) let lex_t : FStar_Syntax_Syntax.term = (fvar_const FStar_Syntax_Const.lex_t_lid) @@ -1366,39 +1395,39 @@ let t_haseq : FStar_Syntax_Syntax.term = (FStar_Syntax_Syntax.fvar FStar_Syntax_ let lcomp_of_comp : (FStar_Syntax_Syntax.comp', Prims.unit) FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.lcomp = (fun c0 -> ( -let _38_1282 = (match (c0.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Total (_38_1273) -> begin +let _38_1292 = (match (c0.FStar_Syntax_Syntax.n) with +| FStar_Syntax_Syntax.Total (_38_1283) -> begin ((FStar_Syntax_Const.effect_Tot_lid), ((FStar_Syntax_Syntax.TOTAL)::[])) end -| FStar_Syntax_Syntax.GTotal (_38_1276) -> begin +| FStar_Syntax_Syntax.GTotal (_38_1286) -> begin ((FStar_Syntax_Const.effect_GTot_lid), ((FStar_Syntax_Syntax.SOMETRIVIAL)::[])) end | FStar_Syntax_Syntax.Comp (c) -> begin ((c.FStar_Syntax_Syntax.effect_name), (c.FStar_Syntax_Syntax.flags)) end) -in (match (_38_1282) with +in (match (_38_1292) with | (eff_name, flags) -> begin -{FStar_Syntax_Syntax.eff_name = eff_name; FStar_Syntax_Syntax.res_typ = (comp_result c0); FStar_Syntax_Syntax.cflags = flags; FStar_Syntax_Syntax.comp = (fun _38_1283 -> (match (()) with +{FStar_Syntax_Syntax.eff_name = eff_name; FStar_Syntax_Syntax.res_typ = (comp_result c0); FStar_Syntax_Syntax.cflags = flags; FStar_Syntax_Syntax.comp = (fun _38_1293 -> (match (()) with | () -> begin c0 end))} end))) -let mk_forall : FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.typ -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun x body -> (let _133_462 = (let _133_461 = (let _133_460 = (let _133_459 = (FStar_Syntax_Syntax.iarg x.FStar_Syntax_Syntax.sort) -in (let _133_458 = (let _133_457 = (let _133_456 = (let _133_455 = (let _133_450 = (FStar_Syntax_Syntax.mk_binder x) -in (_133_450)::[]) -in (let _133_454 = (let _133_453 = (let _133_452 = (let _133_451 = (FStar_Syntax_Syntax.mk_Total ktype0) -in (FStar_All.pipe_left lcomp_of_comp _133_451)) -in FStar_Util.Inl (_133_452)) -in Some (_133_453)) -in (abs _133_455 body _133_454))) -in (FStar_Syntax_Syntax.as_arg _133_456)) -in (_133_457)::[]) -in (_133_459)::_133_458)) -in ((tforall), (_133_460))) -in FStar_Syntax_Syntax.Tm_app (_133_461)) -in (FStar_Syntax_Syntax.mk _133_462 None FStar_Range.dummyRange))) +let mk_forall : FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.typ -> (FStar_Syntax_Syntax.term', FStar_Syntax_Syntax.term') FStar_Syntax_Syntax.syntax = (fun x body -> (let _133_474 = (let _133_473 = (let _133_472 = (let _133_471 = (FStar_Syntax_Syntax.iarg x.FStar_Syntax_Syntax.sort) +in (let _133_470 = (let _133_469 = (let _133_468 = (let _133_467 = (let _133_462 = (FStar_Syntax_Syntax.mk_binder x) +in (_133_462)::[]) +in (let _133_466 = (let _133_465 = (let _133_464 = (let _133_463 = (FStar_Syntax_Syntax.mk_Total ktype0) +in (FStar_All.pipe_left lcomp_of_comp _133_463)) +in FStar_Util.Inl (_133_464)) +in Some (_133_465)) +in (abs _133_467 body _133_466))) +in (FStar_Syntax_Syntax.as_arg _133_468)) +in (_133_469)::[]) +in (_133_471)::_133_470)) +in ((tforall), (_133_472))) +in FStar_Syntax_Syntax.Tm_app (_133_473)) +in (FStar_Syntax_Syntax.mk _133_474 None FStar_Range.dummyRange))) let rec close_forall : FStar_Syntax_Syntax.binder Prims.list -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ = (fun bs f -> (FStar_List.fold_right (fun b f -> if (FStar_Syntax_Syntax.is_null_binder b) then begin @@ -1409,25 +1438,25 @@ end) bs f)) let rec is_wild_pat = (fun p -> (match (p.FStar_Syntax_Syntax.v) with -| FStar_Syntax_Syntax.Pat_wild (_38_1292) -> begin +| FStar_Syntax_Syntax.Pat_wild (_38_1302) -> begin true end -| _38_1295 -> begin +| _38_1305 -> begin false end)) let if_then_else = (fun b t1 t2 -> ( -let then_branch = (let _133_473 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t1.FStar_Syntax_Syntax.pos) -in ((_133_473), (None), (t1))) +let then_branch = (let _133_485 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (true))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t1.FStar_Syntax_Syntax.pos) +in ((_133_485), (None), (t1))) in ( -let else_branch = (let _133_474 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (false))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t2.FStar_Syntax_Syntax.pos) -in ((_133_474), (None), (t2))) -in (let _133_476 = (let _133_475 = (FStar_Range.union_ranges t1.FStar_Syntax_Syntax.pos t2.FStar_Syntax_Syntax.pos) -in (FStar_Range.union_ranges b.FStar_Syntax_Syntax.pos _133_475)) -in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_match (((b), ((then_branch)::(else_branch)::[])))) None _133_476))))) +let else_branch = (let _133_486 = (FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool (false))) FStar_Syntax_Syntax.tun.FStar_Syntax_Syntax.n t2.FStar_Syntax_Syntax.pos) +in ((_133_486), (None), (t2))) +in (let _133_488 = (let _133_487 = (FStar_Range.union_ranges t1.FStar_Syntax_Syntax.pos t2.FStar_Syntax_Syntax.pos) +in (FStar_Range.union_ranges b.FStar_Syntax_Syntax.pos _133_487)) +in (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_match (((b), ((then_branch)::(else_branch)::[])))) None _133_488))))) type qpats = @@ -1468,20 +1497,20 @@ end)) let ___QAll____0 = (fun projectee -> (match (projectee) with -| QAll (_38_1303) -> begin -_38_1303 +| QAll (_38_1313) -> begin +_38_1313 end)) let ___QEx____0 = (fun projectee -> (match (projectee) with -| QEx (_38_1306) -> begin -_38_1306 +| QEx (_38_1316) -> begin +_38_1316 end)) let ___BaseConn____0 = (fun projectee -> (match (projectee) with -| BaseConn (_38_1309) -> begin -_38_1309 +| BaseConn (_38_1319) -> begin +_38_1319 end)) @@ -1494,7 +1523,7 @@ in (match (f.FStar_Syntax_Syntax.n) with | (FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_monadic (_))) | (FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_monadic_lift (_))) -> begin (unmeta_monadic t) end -| _38_1326 -> begin +| _38_1336 -> begin f end))) in ( @@ -1504,13 +1533,13 @@ let destruct_base_conn = (fun f -> ( let connectives = (((FStar_Syntax_Const.true_lid), ((Prims.parse_int "0"))))::(((FStar_Syntax_Const.false_lid), ((Prims.parse_int "0"))))::(((FStar_Syntax_Const.and_lid), ((Prims.parse_int "2"))))::(((FStar_Syntax_Const.or_lid), ((Prims.parse_int "2"))))::(((FStar_Syntax_Const.imp_lid), ((Prims.parse_int "2"))))::(((FStar_Syntax_Const.iff_lid), ((Prims.parse_int "2"))))::(((FStar_Syntax_Const.ite_lid), ((Prims.parse_int "3"))))::(((FStar_Syntax_Const.not_lid), ((Prims.parse_int "1"))))::(((FStar_Syntax_Const.eq2_lid), ((Prims.parse_int "3"))))::(((FStar_Syntax_Const.eq2_lid), ((Prims.parse_int "2"))))::(((FStar_Syntax_Const.eq3_lid), ((Prims.parse_int "4"))))::(((FStar_Syntax_Const.eq3_lid), ((Prims.parse_int "2"))))::[] in ( -let rec aux = (fun f _38_1334 -> (match (_38_1334) with +let rec aux = (fun f _38_1344 -> (match (_38_1344) with | (lid, arity) -> begin ( -let _38_1337 = (let _133_529 = (unmeta_monadic f) -in (head_and_args _133_529)) -in (match (_38_1337) with +let _38_1347 = (let _133_541 = (unmeta_monadic f) +in (head_and_args _133_541)) +in (match (_38_1347) with | (t, args) -> begin ( @@ -1530,12 +1559,12 @@ let patterns = (fun t -> ( let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with | FStar_Syntax_Syntax.Tm_meta (t, FStar_Syntax_Syntax.Meta_pattern (pats)) -> begin -(let _133_532 = (FStar_Syntax_Subst.compress t) -in ((pats), (_133_532))) +(let _133_544 = (FStar_Syntax_Subst.compress t) +in ((pats), (_133_544))) end -| _38_1348 -> begin -(let _133_533 = (FStar_Syntax_Subst.compress t) -in (([]), (_133_533))) +| _38_1358 -> begin +(let _133_545 = (FStar_Syntax_Subst.compress t) +in (([]), (_133_545))) end))) in ( @@ -1550,40 +1579,40 @@ in ( let flat = (fun t -> ( -let _38_1358 = (head_and_args t) -in (match (_38_1358) with +let _38_1368 = (head_and_args t) +in (match (_38_1368) with | (t, args) -> begin -(let _133_545 = (un_uinst t) -in (let _133_544 = (FStar_All.pipe_right args (FStar_List.map (fun _38_1361 -> (match (_38_1361) with +(let _133_557 = (un_uinst t) +in (let _133_556 = (FStar_All.pipe_right args (FStar_List.map (fun _38_1371 -> (match (_38_1371) with | (t, imp) -> begin -(let _133_543 = (unascribe t) -in ((_133_543), (imp))) +(let _133_555 = (unascribe t) +in ((_133_555), (imp))) end)))) -in ((_133_545), (_133_544)))) +in ((_133_557), (_133_556)))) end))) in ( -let rec aux = (fun qopt out t -> (match ((let _133_552 = (flat t) -in ((qopt), (_133_552)))) with +let rec aux = (fun qopt out t -> (match ((let _133_564 = (flat t) +in ((qopt), (_133_564)))) with | ((Some (fa), ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (tc); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, (({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs ((b)::[], t2, _); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, _))::[]))) | ((Some (fa), ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (tc); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, (_)::(({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs ((b)::[], t2, _); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, _))::[]))) when (is_q fa tc) -> begin (aux qopt ((b)::out) t2) end | ((None, ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (tc); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, (({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs ((b)::[], t2, _); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, _))::[]))) | ((None, ({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar (tc); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, (_)::(({FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs ((b)::[], t2, _); FStar_Syntax_Syntax.tk = _; FStar_Syntax_Syntax.pos = _; FStar_Syntax_Syntax.vars = _}, _))::[]))) when (is_qlid tc.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v) -> begin (aux (Some ((is_forall tc.FStar_Syntax_Syntax.fv_name.FStar_Syntax_Syntax.v))) ((b)::out) t2) end -| (Some (b), _38_1488) -> begin +| (Some (b), _38_1498) -> begin ( let bs = (FStar_List.rev out) in ( -let _38_1493 = (FStar_Syntax_Subst.open_term bs t) -in (match (_38_1493) with +let _38_1503 = (FStar_Syntax_Subst.open_term bs t) +in (match (_38_1503) with | (bs, t) -> begin ( -let _38_1496 = (patterns t) -in (match (_38_1496) with +let _38_1506 = (patterns t) +in (match (_38_1506) with | (pats, body) -> begin if b then begin Some (QAll (((bs), (pats), (body)))) @@ -1593,7 +1622,7 @@ end end)) end))) end -| _38_1498 -> begin +| _38_1508 -> begin None end)) in (aux None [] t))))) @@ -1611,27 +1640,27 @@ end))))))) let action_as_lb : FStar_Syntax_Syntax.action -> FStar_Syntax_Syntax.sigelt = (fun a -> ( -let lb = (let _133_556 = (let _133_555 = (FStar_Syntax_Syntax.lid_as_fv a.FStar_Syntax_Syntax.action_name FStar_Syntax_Syntax.Delta_equational None) -in FStar_Util.Inr (_133_555)) -in (close_univs_and_mk_letbinding None _133_556 a.FStar_Syntax_Syntax.action_univs a.FStar_Syntax_Syntax.action_typ FStar_Syntax_Const.effect_Tot_lid a.FStar_Syntax_Syntax.action_defn)) +let lb = (let _133_568 = (let _133_567 = (FStar_Syntax_Syntax.lid_as_fv a.FStar_Syntax_Syntax.action_name FStar_Syntax_Syntax.Delta_equational None) +in FStar_Util.Inr (_133_567)) +in (close_univs_and_mk_letbinding None _133_568 a.FStar_Syntax_Syntax.action_univs a.FStar_Syntax_Syntax.action_typ FStar_Syntax_Const.effect_Tot_lid a.FStar_Syntax_Syntax.action_defn)) in FStar_Syntax_Syntax.Sig_let (((((false), ((lb)::[]))), (a.FStar_Syntax_Syntax.action_defn.FStar_Syntax_Syntax.pos), ((a.FStar_Syntax_Syntax.action_name)::[]), ([]))))) let mk_reify = (fun t -> ( let reify_ = (FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify)) None t.FStar_Syntax_Syntax.pos) -in (let _133_561 = (let _133_560 = (let _133_559 = (let _133_558 = (FStar_Syntax_Syntax.as_arg t) -in (_133_558)::[]) -in ((reify_), (_133_559))) -in FStar_Syntax_Syntax.Tm_app (_133_560)) -in (FStar_Syntax_Syntax.mk _133_561 None t.FStar_Syntax_Syntax.pos)))) +in (let _133_573 = (let _133_572 = (let _133_571 = (let _133_570 = (FStar_Syntax_Syntax.as_arg t) +in (_133_570)::[]) +in ((reify_), (_133_571))) +in FStar_Syntax_Syntax.Tm_app (_133_572)) +in (FStar_Syntax_Syntax.mk _133_573 None t.FStar_Syntax_Syntax.pos)))) let rec delta_qualifier : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth = (fun t -> ( let t = (FStar_Syntax_Subst.compress t) in (match (t.FStar_Syntax_Syntax.n) with -| FStar_Syntax_Syntax.Tm_delayed (_38_1510) -> begin +| FStar_Syntax_Syntax.Tm_delayed (_38_1520) -> begin (FStar_All.failwith "Impossible") end | FStar_Syntax_Syntax.Tm_fvar (fv) -> begin @@ -1669,35 +1698,35 @@ end)) in (aux d)))) -let is_unknown : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_573 = (FStar_Syntax_Subst.compress t) -in _133_573.FStar_Syntax_Syntax.n)) with +let is_unknown : FStar_Syntax_Syntax.term -> Prims.bool = (fun t -> (match ((let _133_585 = (FStar_Syntax_Subst.compress t) +in _133_585.FStar_Syntax_Syntax.n)) with | FStar_Syntax_Syntax.Tm_unknown -> begin true end -| _38_1587 -> begin +| _38_1597 -> begin false end)) let rec list_elements : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term Prims.list Prims.option = (fun e -> ( -let _38_1591 = (let _133_576 = (unmeta e) -in (head_and_args _133_576)) -in (match (_38_1591) with +let _38_1601 = (let _133_588 = (unmeta e) +in (head_and_args _133_588)) +in (match (_38_1601) with | (head, args) -> begin -(match ((let _133_578 = (let _133_577 = (un_uinst head) -in _133_577.FStar_Syntax_Syntax.n) -in ((_133_578), (args)))) with -| (FStar_Syntax_Syntax.Tm_fvar (fv), _38_1595) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.nil_lid) -> begin +(match ((let _133_590 = (let _133_589 = (un_uinst head) +in _133_589.FStar_Syntax_Syntax.n) +in ((_133_590), (args)))) with +| (FStar_Syntax_Syntax.Tm_fvar (fv), _38_1605) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.nil_lid) -> begin Some ([]) end -| (FStar_Syntax_Syntax.Tm_fvar (fv), (_38_1608)::((hd, _38_1605))::((tl, _38_1601))::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.cons_lid) -> begin -(let _133_581 = (let _133_580 = (let _133_579 = (list_elements tl) -in (FStar_Util.must _133_579)) -in (hd)::_133_580) -in Some (_133_581)) +| (FStar_Syntax_Syntax.Tm_fvar (fv), (_38_1618)::((hd, _38_1615))::((tl, _38_1611))::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Syntax_Const.cons_lid) -> begin +(let _133_593 = (let _133_592 = (let _133_591 = (list_elements tl) +in (FStar_Util.must _133_591)) +in (hd)::_133_592) +in Some (_133_593)) end -| _38_1612 -> begin +| _38_1622 -> begin None end) end))) diff --git a/src/ocaml-output/FStar_TypeChecker_Tc.ml b/src/ocaml-output/FStar_TypeChecker_Tc.ml index bc84c2c378d..c3624991b7b 100755 --- a/src/ocaml-output/FStar_TypeChecker_Tc.ml +++ b/src/ocaml-output/FStar_TypeChecker_Tc.ml @@ -227,7 +227,7 @@ in (let _154_87 = (let _154_84 = (op (([]), (a.FStar_Syntax_Syntax.action_defn)) in (Prims.snd _154_84)) in (let _154_86 = (let _154_85 = (op (([]), (a.FStar_Syntax_Syntax.action_typ))) in (Prims.snd _154_85)) -in {FStar_Syntax_Syntax.action_name = _59_144.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_univs = _59_144.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _154_87; FStar_Syntax_Syntax.action_typ = _154_86})))) ed.FStar_Syntax_Syntax.actions) +in {FStar_Syntax_Syntax.action_name = _59_144.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_unqualified_name = _59_144.FStar_Syntax_Syntax.action_unqualified_name; FStar_Syntax_Syntax.action_univs = _59_144.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _154_87; FStar_Syntax_Syntax.action_typ = _154_86})))) ed.FStar_Syntax_Syntax.actions) in {FStar_Syntax_Syntax.qualifiers = _59_141.FStar_Syntax_Syntax.qualifiers; FStar_Syntax_Syntax.mname = _59_141.FStar_Syntax_Syntax.mname; FStar_Syntax_Syntax.univs = _59_141.FStar_Syntax_Syntax.univs; FStar_Syntax_Syntax.binders = _59_141.FStar_Syntax_Syntax.binders; FStar_Syntax_Syntax.signature = _59_141.FStar_Syntax_Syntax.signature; FStar_Syntax_Syntax.ret_wp = _154_101; FStar_Syntax_Syntax.bind_wp = _154_100; FStar_Syntax_Syntax.if_then_else = _154_99; FStar_Syntax_Syntax.ite_wp = _154_98; FStar_Syntax_Syntax.stronger = _154_97; FStar_Syntax_Syntax.close_wp = _154_96; FStar_Syntax_Syntax.assert_p = _154_95; FStar_Syntax_Syntax.assume_p = _154_94; FStar_Syntax_Syntax.null_wp = _154_93; FStar_Syntax_Syntax.trivial = _154_92; FStar_Syntax_Syntax.repr = _154_91; FStar_Syntax_Syntax.return_repr = _154_90; FStar_Syntax_Syntax.bind_repr = _154_89; FStar_Syntax_Syntax.actions = _154_88})))))))))))))))) end) in ( @@ -784,7 +784,7 @@ let act_typ = (FStar_TypeChecker_Normalize.normalize ((FStar_TypeChecker_Normali in ( let _59_359 = act -in {FStar_Syntax_Syntax.action_name = _59_359.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_univs = univs; FStar_Syntax_Syntax.action_defn = act_defn; FStar_Syntax_Syntax.action_typ = act_typ})) +in {FStar_Syntax_Syntax.action_name = _59_359.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_unqualified_name = _59_359.FStar_Syntax_Syntax.action_unqualified_name; FStar_Syntax_Syntax.action_univs = univs; FStar_Syntax_Syntax.action_defn = act_defn; FStar_Syntax_Syntax.action_typ = act_typ})) end))))) end)))) end)))) @@ -852,7 +852,7 @@ let _59_400 = () in ( let _59_402 = act -in {FStar_Syntax_Syntax.action_name = _59_402.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_univs = univs; FStar_Syntax_Syntax.action_defn = defn; FStar_Syntax_Syntax.action_typ = typ})) +in {FStar_Syntax_Syntax.action_name = _59_402.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_unqualified_name = _59_402.FStar_Syntax_Syntax.action_unqualified_name; FStar_Syntax_Syntax.action_univs = univs; FStar_Syntax_Syntax.action_defn = defn; FStar_Syntax_Syntax.action_typ = typ})) end)) end))) in ( @@ -1237,7 +1237,7 @@ in (let _154_428 = (let _154_427 = ( let _59_585 = action in (let _154_426 = (apply_close action_elab) in (let _154_425 = (apply_close action_typ_with_wp) -in {FStar_Syntax_Syntax.action_name = _59_585.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_univs = _59_585.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _154_426; FStar_Syntax_Syntax.action_typ = _154_425}))) +in {FStar_Syntax_Syntax.action_name = _59_585.FStar_Syntax_Syntax.action_name; FStar_Syntax_Syntax.action_unqualified_name = _59_585.FStar_Syntax_Syntax.action_unqualified_name; FStar_Syntax_Syntax.action_univs = _59_585.FStar_Syntax_Syntax.action_univs; FStar_Syntax_Syntax.action_defn = _154_426; FStar_Syntax_Syntax.action_typ = _154_425}))) in (_154_427)::actions) in ((dmff_env), (_154_428))))))) end)) diff --git a/src/ocaml-output/FStar_TypeChecker_TcTerm.ml b/src/ocaml-output/FStar_TypeChecker_TcTerm.ml index 01eea32ce2f..79ff5e90162 100755 --- a/src/ocaml-output/FStar_TypeChecker_TcTerm.ml +++ b/src/ocaml-output/FStar_TypeChecker_TcTerm.ml @@ -915,7 +915,7 @@ in (match (_58_591) with (no_reflect ()) end | Some (ed) -> begin -if (not ((FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reflectable)))) then begin +if (not ((FStar_All.pipe_right ed.FStar_Syntax_Syntax.qualifiers FStar_Syntax_Syntax.contains_reflectable))) then begin (no_reflect ()) end else begin ( diff --git a/src/ocaml-output/FStar_TypeChecker_Util.ml b/src/ocaml-output/FStar_TypeChecker_Util.ml index 627bc480228..7ba8e50fb36 100755 --- a/src/ocaml-output/FStar_TypeChecker_Util.ml +++ b/src/ocaml-output/FStar_TypeChecker_Util.ml @@ -2888,10 +2888,10 @@ end)) in ( let reification = (fun _56_12 -> (match (_56_12) with -| (FStar_Syntax_Syntax.Reifiable) | (FStar_Syntax_Syntax.Reflectable) -> begin +| (FStar_Syntax_Syntax.Reifiable) | (FStar_Syntax_Syntax.Reflectable (_)) -> begin true end -| _56_1694 -> begin +| _56_1696 -> begin false end)) in ( @@ -2900,7 +2900,7 @@ let inferred = (fun _56_13 -> (match (_56_13) with | (FStar_Syntax_Syntax.Discriminator (_)) | (FStar_Syntax_Syntax.Projector (_)) | (FStar_Syntax_Syntax.RecordType (_)) | (FStar_Syntax_Syntax.RecordConstructor (_)) | (FStar_Syntax_Syntax.ExceptionConstructor) | (FStar_Syntax_Syntax.HasMaskedEffect) | (FStar_Syntax_Syntax.Effect) -> begin true end -| _56_1713 -> begin +| _56_1715 -> begin false end)) in ( @@ -2909,7 +2909,7 @@ let has_eq = (fun _56_14 -> (match (_56_14) with | (FStar_Syntax_Syntax.Noeq) | (FStar_Syntax_Syntax.Unopteq) -> begin true end -| _56_1719 -> begin +| _56_1721 -> begin false end)) in ( @@ -2933,13 +2933,13 @@ end | FStar_Syntax_Syntax.Logic -> begin (FStar_All.pipe_right quals (FStar_List.for_all (fun x -> (((((x = q) || (x = FStar_Syntax_Syntax.Assumption)) || (inferred x)) || (visibility x)) || (reducibility x))))) end -| (FStar_Syntax_Syntax.Reifiable) | (FStar_Syntax_Syntax.Reflectable) -> begin +| (FStar_Syntax_Syntax.Reifiable) | (FStar_Syntax_Syntax.Reflectable (_)) -> begin (FStar_All.pipe_right quals (FStar_List.for_all (fun x -> ((((reification x) || (inferred x)) || (visibility x)) || (x = FStar_Syntax_Syntax.TotalEffect))))) end | FStar_Syntax_Syntax.Private -> begin true end -| _56_1746 -> begin +| _56_1750 -> begin true end)) in ( @@ -2963,29 +2963,29 @@ in ( let err = (fun msg -> (err' (Prims.strcat ": " msg))) in ( -let err' = (fun _56_1757 -> (match (()) with +let err' = (fun _56_1761 -> (match (()) with | () -> begin (err' "") end)) in ( -let _56_1758 = if ((FStar_List.length quals) <> (FStar_List.length no_dup_quals)) then begin +let _56_1762 = if ((FStar_List.length quals) <> (FStar_List.length no_dup_quals)) then begin (err "duplicate qualifiers") end else begin () end in ( -let _56_1760 = if (not ((FStar_All.pipe_right quals (FStar_List.for_all (quals_combo_ok quals))))) then begin +let _56_1764 = if (not ((FStar_All.pipe_right quals (FStar_List.for_all (quals_combo_ok quals))))) then begin (err "ill-formed combination") end else begin () end in (match (se) with -| FStar_Syntax_Syntax.Sig_let ((is_rec, _56_1764), _56_1767, _56_1769, _56_1771) -> begin +| FStar_Syntax_Syntax.Sig_let ((is_rec, _56_1768), _56_1771, _56_1773, _56_1775) -> begin ( -let _56_1774 = if (is_rec && (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen))) then begin +let _56_1778 = if (is_rec && (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen))) then begin (err "recursive definitions cannot be marked inline") end else begin () @@ -2996,49 +2996,49 @@ end else begin () end) end -| FStar_Syntax_Syntax.Sig_bundle (_56_1778) -> begin +| FStar_Syntax_Syntax.Sig_bundle (_56_1782) -> begin if (not ((FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> ((((x = FStar_Syntax_Syntax.Abstract) || (inferred x)) || (visibility x)) || (has_eq x))))))) then begin (err' ()) end else begin () end end -| FStar_Syntax_Syntax.Sig_declare_typ (_56_1782) -> begin +| FStar_Syntax_Syntax.Sig_declare_typ (_56_1786) -> begin if (FStar_All.pipe_right quals (FStar_Util.for_some has_eq)) then begin (err' ()) end else begin () end end -| FStar_Syntax_Syntax.Sig_assume (_56_1785) -> begin +| FStar_Syntax_Syntax.Sig_assume (_56_1789) -> begin if (not ((FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> ((visibility x) || (x = FStar_Syntax_Syntax.Assumption))))))) then begin (err' ()) end else begin () end end -| FStar_Syntax_Syntax.Sig_new_effect (_56_1789) -> begin +| FStar_Syntax_Syntax.Sig_new_effect (_56_1793) -> begin if (not ((FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> ((((x = FStar_Syntax_Syntax.TotalEffect) || (inferred x)) || (visibility x)) || (reification x))))))) then begin (err' ()) end else begin () end end -| FStar_Syntax_Syntax.Sig_new_effect_for_free (_56_1793) -> begin +| FStar_Syntax_Syntax.Sig_new_effect_for_free (_56_1797) -> begin if (not ((FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> ((((x = FStar_Syntax_Syntax.TotalEffect) || (inferred x)) || (visibility x)) || (reification x))))))) then begin (err' ()) end else begin () end end -| FStar_Syntax_Syntax.Sig_effect_abbrev (_56_1797) -> begin +| FStar_Syntax_Syntax.Sig_effect_abbrev (_56_1801) -> begin if (not ((FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> ((inferred x) || (visibility x))))))) then begin (err' ()) end else begin () end end -| _56_1801 -> begin +| _56_1805 -> begin () end))))))))))))))))) diff --git a/src/parser/ast.fs b/src/parser/ast.fs index b3921388d1a..caf2b62fe44 100644 --- a/src/parser/ast.fs +++ b/src/parser/ast.fs @@ -54,6 +54,10 @@ type term' = | Tvar of ident | Var of lid // a qualified identifier that starts with a lowercase (Foo.Bar.baz) | Name of lid // a qualified identifier that starts with an uppercase (Foo.Bar.Baz) + | Projector of lid * ident (* a data constructor followed by one of + its formal parameters, or an effect + followed by one of its actions or + "fields" *) | Construct of lid * list<(term*imp)> (* data, type: bool in each arg records an implicit *) | Abs of list * term | App of term * term * imp (* aqual marks an explicitly provided implicit parameter *) @@ -77,6 +81,7 @@ type term' = | Ensures of term * option | Labeled of term * string * bool | Assign of ident * term + | Discrim of lid (* Some? (formerly is_Some) *) and term = {tm:term'; range:range; level:level} diff --git a/src/parser/dep.fs b/src/parser/dep.fs index be462ff07d6..246fb65b2b5 100644 --- a/src/parser/dep.fs +++ b/src/parser/dep.fs @@ -210,7 +210,7 @@ let collect_one (verify_flags: list<(string * ref)>) (verify_mode: verify_ let record_open let_open lid = let key = lowercase_join_longident lid true in - begin match smap_try_find original_map key with + begin match smap_try_find working_map key with | Some pair -> List.iter (fun f -> add_dep (lowercase_module_name f)) (list_of_pair pair) | None -> @@ -399,6 +399,8 @@ let collect_one (verify_flags: list<(string * ref)>) (verify_mode: verify_ | Tvar _ -> () | Var lid + | AST.Projector (lid, _) + | AST.Discrim lid | Name lid -> record_lid false lid | Construct (lid, termimps) -> diff --git a/src/parser/desugar.fs b/src/parser/desugar.fs index 70a2bd9f1f3..1c7949b12cf 100644 --- a/src/parser/desugar.fs +++ b/src/parser/desugar.fs @@ -249,6 +249,8 @@ and free_type_vars env t = match (unparen t).tm with | Wild | Const _ | Var _ + | AST.Projector _ + | AST.Discrim _ | Name _ -> [] | Requires (t, _) @@ -550,6 +552,15 @@ and desugar_typ_or_exp (env:env_t) (t:term) : either = and desugar_exp env e = desugar_exp_maybe_top false env e +and desugar_name setpos env l = + if l.str = "ref" + then begin match DesugarEnv.try_lookup_lid env Const.alloc_lid with + | None -> raise (Error ("Identifier 'ref' not found; include lib/FStar.ST.fst in your path", range_of_lid l)) + | Some e -> setpos e + end + else setpos <| fail_or env (DesugarEnv.try_lookup_lid env) l + + and desugar_exp_maybe_top (top_level:bool) (env:env_t) (top:term) : exp = let pos e = e None top.range in let setpos e = {e with pos=top.range} in @@ -568,12 +579,7 @@ and desugar_exp_maybe_top (top_level:bool) (env:env_t) (top:term) : exp = | Var l | Name l -> - if l.str = "ref" - then begin match DesugarEnv.try_lookup_lid env Const.alloc_lid with - | None -> raise (Error ("Identifier 'ref' not found; include lib/FStar.ST.fst in your path", range_of_lid l)) - | Some e -> setpos e - end - else setpos <| fail_or env (DesugarEnv.try_lookup_lid env) l + desugar_name setpos env l | Construct(l, args) -> let dt = pos <| mk_Exp_fvar(fail_or env (DesugarEnv.try_lookup_datacon env) l, Some Data_ctor) in @@ -804,6 +810,17 @@ and desugar_exp_maybe_top (top_level:bool) (env:env_t) (top:term) : exp = | Paren e -> desugar_exp env e + | AST.Projector (ns, id) -> + (* translating ".." back into "." -- support needed by 'make -C + src test', namely 'make -C examples/unit-tests sall', more + precisely examples/unit_tests/Unit1.Basic.fst *) + let l = qual ns id in + desugar_name setpos env l + + | Discrim lid -> + let lid' = Util.mk_discriminator lid in + desugar_name setpos env lid' + | _ -> error "Unexpected term" top top.range end diff --git a/src/parser/dsenv.fsi b/src/parser/dsenv.fsi index 9ebd8a7d8bf..902ff16d578 100644 --- a/src/parser/dsenv.fsi +++ b/src/parser/dsenv.fsi @@ -69,6 +69,7 @@ type foundname = val fail_or: env -> (lident -> option<'a>) -> lident -> 'a val fail_or2: (ident -> option<'a>) -> ident -> 'a +val qual: lident -> ident -> lident val qualify: env -> ident -> lident val qualify_lid: env -> lident -> lident diff --git a/src/parser/env.fs b/src/parser/env.fs index 7c491353687..8812b6531f3 100644 --- a/src/parser/env.fs +++ b/src/parser/env.fs @@ -31,52 +31,66 @@ open FStar.Ident module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util +type local_binding = (ident * bv * bool) (* local name binding for name resolution, paired with an env-generated unique name and a boolean that is true when the variable has been introduced with let-mutable *) +type rec_binding = (ident * lid * delta_depth) (* name bound by recursive type and top-level let-bindings definitions only *) +type module_abbrev = (ident * lident) (* module X = A.B.C, where A.B.C is fully qualified and already resolved *) + +type open_kind = (* matters only for resolving names with some module qualifier *) +| Open_module (* only opens the module, not the namespace *) +| Open_namespace (* opens the whole namespace *) + +type open_module_or_namespace = (lident * open_kind) (* lident fully qualified name, already resolved. *) + +type record_or_dc = { + typename: lident; + constrname: lident; + parms: binders; + fields: list<(fieldname * typ)>; + is_record:bool +} + +type scope_mod = +| Local_binding of local_binding +| Rec_binding of rec_binding +| Module_abbrev of module_abbrev +| Open_module_or_namespace of open_module_or_namespace +| 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 env = { curmodule: option; (* name of the module being desugared *) + curmonad: option; (* current monad being desugared *) modules: list<(lident * modul)>; (* previously desugared modules *) - open_namespaces: list; (* fully qualified names, in order of precedence *) - modul_abbrevs: list<(ident * lident)>; (* module X = A.B.C *) + scope_mods: list; (* toplevel or definition-local scope modifiers *) sigaccum: sigelts; (* type declarations being accumulated for the current module *) - localbindings: list<(ident * bv * bool)>; (* local name bindings for name resolution, paired with an env-generated unique name and a boolean that is true when the variable has been introduced with let-mutable *) - recbindings: list<(ident* lid * delta_depth)>; (* names bound by recursive type and top-level let-bindings definitions only *) sigmap: Util.smap<(sigelt * bool)>; (* bool indicates that this was declared in an interface file *) default_result_effect:lident; (* either Tot or ML, depending on the what kind of term we're desugaring *) iface: bool; (* remove? whether or not we're desugaring an interface; different scoping rules apply *) admitted_iface: bool; (* is it an admitted interface; different scoping rules apply *) - expect_typ: bool; (* syntatically, expect a type at this position in the term *) + expect_typ: bool; (* syntactically, expect a type at this position in the term *) } type foundname = | Term_name of typ * bool // indicates if mutable | Eff_name of sigelt * lident -type record_or_dc = { - typename: lident; - constrname: lident; - parms: binders; - fields: list<(fieldname * typ)>; - is_record:bool -} - // VALS_HACK_HERE let open_modules e = e.modules let current_module env = match env.curmodule with | None -> failwith "Unset current module" | Some m -> m -let qual lid id = set_lid_range (lid_of_ids (lid.ns @ [lid.ident;id])) id.idRange -let qualify env id = qual (current_module env) id -let qualify_lid env lid = - let cur = current_module env in - set_lid_range (lid_of_ids (cur.ns @ [cur.ident] @ lid.ns @ [lid.ident])) (range_of_lid lid) +let qual = qual_id +let qualify env id = + match env.curmonad with + | None -> qual (current_module env) id + | Some monad -> mk_field_projector_name_from_ident (qual (current_module env) monad) id let new_sigmap () = Util.smap_create 100 let empty_env () = {curmodule=None; + curmonad=None; modules=[]; - open_namespaces=[]; - modul_abbrevs=[]; + scope_mods=[]; sigaccum=[]; - localbindings=[]; - recbindings=[]; sigmap=new_sigmap(); default_result_effect=Const.effect_Tot_lid; iface=false; @@ -104,53 +118,205 @@ 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 unmangleOpName (id:ident) : option = +let unmangleOpName (id:ident) : option<(term * bool)> = + let t = find_map unmangleMap (fun (x,y,dd,dq) -> if (id.idText = x) then Some (S.fvar (lid_of_path ["Prims"; y] id.idRange) dd dq) else None) + in + match t with + | Some v -> Some (v, false) + | None -> None + +type cont_t<'a> = + | Cont_ok of 'a (* found *) + | Cont_fail (* not found, do not retry *) + | Cont_ignore (* not found, retry *) + +let option_of_cont (k_ignore: unit -> option<'a>) = function + | Cont_ok a -> Some a + | Cont_fail -> None + | Cont_ignore -> k_ignore () + +(* Unqualified identifier lookup *) + +let find_in_record ns id record cont = + let needs_constrname = not (field_projector_contains_constructor id.idText) in + let constrname = record.constrname.ident in + let fname = + if needs_constrname + then mk_field_projector_name_from_ident (lid_of_ids (ns @ [constrname])) id + else lid_of_ids (ns @ [id]) + in + let fname = set_lid_range fname id.idRange in + let find = + Util.find_map record.fields (fun (f, _) -> + if lid_equals fname f + then Some(record, fname) + else None) + in + match find with + | Some r -> cont r + | None -> Cont_ignore + +let try_lookup_id'' + env + (id: ident) + (k_local_binding: local_binding -> cont_t<'a>) + (k_rec_binding: rec_binding -> cont_t<'a>) + (k_record: (record_or_dc * fieldname) -> cont_t<'a>) + (find_in_module: lident -> cont_t<'a>) + (lookup_default_id: cont_t<'a> -> ident -> cont_t<'a>) + = + let check_local_binding_id : local_binding -> bool = function + (id', _, _) -> id'.idText=id.idText + in + let check_rec_binding_id : rec_binding -> bool = function + (id', _, _) -> id'.idText=id.idText + in + let curmod_ns = ids_of_lid (current_module env) in + let proc = function + | Local_binding l + when check_local_binding_id l -> + k_local_binding l + + | Rec_binding r + when check_rec_binding_id r -> + k_rec_binding r + + | Open_module_or_namespace (ns, _) -> + let lid = qual ns id in + find_in_module lid + + | Top_level_def id' + when id'.idText = id.idText -> + (* indicates a global definition shadowing previous + "open"s. If the definition is not actually found by the + [lookup_default_id] finder, then it may mean that we are in a + module and the [val] was already declared, with the actual + [let] not defined yet, so we must not fail, but ignore. *) + lookup_default_id Cont_ignore id + + | Record_or_dc r -> + find_in_record curmod_ns id r k_record + + | _ -> + Cont_ignore + in + let rec aux = function + | a :: q -> + option_of_cont (fun _ -> aux q) (proc a) + | [] -> + option_of_cont (fun _ -> None) (lookup_default_id Cont_fail id) + + in aux env.scope_mods + +let found_local_binding (id', x, mut) = + (bv_to_name x id'.idRange, mut) + +let find_in_module env lid k_global_def k_not_found = + begin match Util.smap_try_find (sigmap env) lid.str with + | Some sb -> k_global_def lid sb + | None -> k_not_found + end let try_lookup_id env (id:ident) = match unmangleOpName id with - | Some f -> Some (f, false) + | Some f -> Some f | _ -> - find_map env.localbindings (function - | id', x, mut when (id'.idText=id.idText) -> Some (bv_to_name x id.idRange, mut) - | _ -> None) - -let resolve_in_open_namespaces' env lid (finder:lident -> option<'a>) : option<'a> = - let aux (namespaces:list) : option<'a> = - match finder lid with - | Some r -> Some r - | _ -> - let ids = ids_of_lid lid in - find_map namespaces (fun (ns:lident) -> - let full_name = lid_of_ids (ids_of_lid ns @ ids) in - finder full_name) in - aux (current_module env::env.open_namespaces) - -let expand_module_abbrev env lid = + try_lookup_id'' env id (fun r -> Cont_ok (found_local_binding r)) (fun _ -> Cont_fail) (fun _ -> Cont_ignore) (fun i -> find_in_module env i (fun _ _ -> Cont_fail) Cont_ignore) (fun _ _ -> Cont_fail) + +(* Unqualified identifier lookup, if lookup in all open namespaces failed. *) + +let lookup_default_id + env + (id: ident) + (k_global_def: lident -> sigelt * bool -> cont_t<'a>) + (k_not_found: cont_t<'a>) + = + let find_in_monad = match env.curmonad with + | Some _ -> + let lid = qualify env id in + begin match Util.smap_try_find (sigmap env) lid.str with + | Some r -> Some (k_global_def lid r) + | None -> None + end + | None -> None + in + match find_in_monad with + | Some v -> v + | None -> + let lid = qual (current_module env) id in + find_in_module env lid k_global_def k_not_found + +let module_is_defined env lid = + lid_equals lid (current_module env) || + List.existsb (fun x -> lid_equals lid (fst x)) env.modules + +let resolve_module_name env lid (honor_ns: bool) : option = + let nslen = List.length lid.ns in + let rec aux = function + | [] -> + if module_is_defined env lid + then Some lid + else None + + | Open_module_or_namespace (ns, Open_namespace) :: q + when honor_ns -> + let new_lid = lid_of_path (path_of_lid ns @ path_of_lid lid) (range_of_lid lid) + in + if module_is_defined env new_lid + then + Some new_lid + else aux q + + | Module_abbrev (name, modul) :: _ + when nslen = 0 && name.idText = lid.ident.idText -> + Some modul + + | _ :: q -> + aux q + + in + aux env.scope_mods + +(* Generic name resolution. *) + +let resolve_in_open_namespaces'' + env + lid + (k_local_binding: local_binding -> cont_t<'a>) + (k_rec_binding: rec_binding -> cont_t<'a>) + (k_record: (record_or_dc * fieldname) -> cont_t<'a>) + (f_module: cont_t<'a> -> lident -> cont_t<'a>) + (l_default: cont_t<'a> -> ident -> cont_t<'a>) + : option<'a> = match lid.ns with | _ :: _ -> - // Already of the form Foo.Bar. Can't be a module abbreviation. - lid + begin match resolve_module_name env (set_lid_range (lid_of_ids lid.ns) (range_of_lid lid)) true with + | None -> None + | Some modul -> + let lid' = qual modul lid.ident in + option_of_cont (fun _ -> None) (f_module Cont_fail lid') + end | [] -> - let id = lid.ident in - match List.tryFind (fun (id', _) -> id.idText = id'.idText) env.modul_abbrevs with - | None -> lid - | Some (_, lid') -> lid' - -let expand_module_abbrevs env lid = - match lid.ns with - | id::rest -> - begin match env.modul_abbrevs |> List.tryFind (fun (id', _) -> id.idText = id'.idText) with - | None -> lid - | Some (_, lid') -> - Ident.lid_of_ids (Ident.ids_of_lid lid' @ rest @ [lid.ident]) - end - | _ -> lid - -let resolve_in_open_namespaces env lid (finder:lident -> option<'a>) : option<'a> = - resolve_in_open_namespaces' env (expand_module_abbrevs env lid) finder + try_lookup_id'' env lid.ident k_local_binding k_rec_binding k_record (f_module Cont_ignore) l_default + +let cont_of_option (k_none: cont_t<'a>) = function + | Some v -> Cont_ok v + | None -> k_none + +let resolve_in_open_namespaces' + env + lid + (k_local_binding: local_binding -> option<'a>) + (k_rec_binding: rec_binding -> option<'a>) + (k_global_def: lident -> (sigelt * bool) -> option<'a>) + : option<'a> = + let k_global_def' k lid def = cont_of_option k (k_global_def lid def) in + let f_module k lid' = find_in_module env lid' (k_global_def' k) k in + let l_default k i = lookup_default_id env i (k_global_def' k) k in + resolve_in_open_namespaces'' env lid (fun l -> cont_of_option Cont_fail (k_local_binding l)) (fun r -> cont_of_option Cont_fail (k_rec_binding r)) (fun _ -> Cont_ignore) f_module l_default let fv_qual_of_se = function | Sig_datacon(_, _, _, l, _, quals, _, _) -> @@ -170,18 +336,16 @@ let lb_fv lbs lid = let fv = right lb.lbname in if S.fv_eq_lid fv lid then Some fv else None) |> must +let ns_of_lid_equals (lid: lident) (ns: lident) = + List.length lid.ns = List.length (ids_of_lid ns) && + lid_equals (lid_of_ids lid.ns) ns + let try_lookup_name any_val exclude_interf env (lid:lident) : option = let occurrence_range = Ident.range_of_lid lid in - (* Resolve using, in order, - 0. local bindings, if the lid is unqualified - 1. rec bindings, if the lid is unqualified - 2. sig bindings in current module - 3. each open namespace, in reverse order *) - let find_in_sig source_lid = - match Util.smap_try_find (sigmap env) source_lid.str with - | Some (_, true) when exclude_interf -> None - | None -> None - | Some (se, _) -> + + let k_global_def source_lid = function + | (_, true) when exclude_interf -> None + | (se, _) -> begin match se with | Sig_inductive_typ _ -> Some (Term_name(S.fvar source_lid Delta_constant None, false)) | Sig_datacon _ -> Some (Term_name(S.fvar source_lid Delta_constant (fv_qual_of_se se), false)) @@ -193,35 +357,39 @@ let try_lookup_name any_val exclude_interf env (lid:lident) : option || quals |> Util.for_some (function Assumption -> true | _ -> false) then let lid = Ident.set_lid_range lid (Ident.range_of_lid source_lid) in let dd = if Util.is_primop_lid lid - || (Util.starts_with lid.nsstr "Prims." && quals |> Util.for_some (function Projector _ | Discriminator _ -> true | _ -> false)) + || (ns_of_lid_equals lid FStar.Syntax.Const.prims_lid && quals |> Util.for_some (function Projector _ | Discriminator _ -> true | _ -> false)) then Delta_equational else Delta_constant in - if quals |> List.contains Reflectable //this is really a M.reflect - then let refl_monad = Ident.lid_of_path (lid.ns |> List.map (fun x -> x.idText)) occurrence_range in + begin match Util.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)) None occurrence_range in Some (Term_name (refl_const, false)) - else Some (Term_name(fvar lid dd (fv_qual_of_se se), false)) + | _ -> Some (Term_name(fvar lid dd (fv_qual_of_se se), false)) + end else None | Sig_new_effect_for_free (ne, _) | 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)) | _ -> None end in - let found_id = match lid.ns with - | [] -> - begin match try_lookup_id env (lid.ident) with - | Some (e, mut) -> Some (Term_name (e, mut)) - | None -> - let recname = qualify env lid.ident in - Util.find_map env.recbindings (fun (id, l, dd) -> if id.idText=lid.ident.idText - then Some (Term_name(S.fvar (set_lid_range l (range_of_lid lid)) dd None, false)) - else None) - end - | _ -> None in + let k_local_binding r = Some (Term_name (found_local_binding r)) + in + + let k_rec_binding (id, l, dd) = Some (Term_name(S.fvar (set_lid_range l (range_of_lid lid)) dd None, false)) + in - match found_id with - | Some _ -> found_id - | _ -> resolve_in_open_namespaces env lid find_in_sig + let found_unmangled = match lid.ns with + | [] -> + begin match unmangleOpName lid.ident with + | Some f -> Some (Term_name f) + | _ -> None + end + | _ -> None + in + + match found_unmangled with + | None -> resolve_in_open_namespaces' env lid k_local_binding k_rec_binding k_global_def + | x -> x let try_lookup_effect_name' exclude_interf env (lid:lident) : option<(sigelt*lident)> = match try_lookup_name true exclude_interf env lid with @@ -242,11 +410,10 @@ let is_effect_name env lid = | Some _ -> true let lookup_letbinding_quals env lid = - let find_in_sig lid = - match Util.smap_try_find (sigmap env) lid.str with - | Some (Sig_declare_typ(lid, _, _, quals, _), _) -> Some quals + let k_global_def lid = function + | (Sig_declare_typ(lid, _, _, quals, _), _) -> Some quals | _ -> None in - match resolve_in_open_namespaces env lid find_in_sig with + match resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def with | Some quals -> quals | _ -> [] @@ -256,25 +423,23 @@ let try_lookup_module env path = | None -> None let try_lookup_let env (lid:lident) = - let find_in_sig lid = - match Util.smap_try_find (sigmap env) lid.str with - | Some (Sig_let((_, lbs), _, _, _), _) -> + let k_global_def lid = function + | (Sig_let((_, lbs), _, _, _), _) -> let fv = lb_fv lbs lid in Some (fvar lid fv.fv_delta fv.fv_qual) | _ -> None in - resolve_in_open_namespaces env lid find_in_sig + resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def let try_lookup_definition env (lid:lident) = - let find_in_sig lid = - match Util.smap_try_find (sigmap env) lid.str with - | Some (Sig_let(lbs, _, _, _), _) -> + let k_global_def lid = function + | (Sig_let(lbs, _, _, _), _) -> Util.find_map (snd lbs) (fun lb -> match lb.lbname with | Inr fv when S.fv_eq_lid fv lid -> Some (lb.lbdef) | _ -> None) | _ -> None in - resolve_in_open_namespaces env lid find_in_sig + resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def let try_lookup_lid' any_val exclude_interf env (lid:lident) : option<(term * bool)> = @@ -284,22 +449,20 @@ let try_lookup_lid' any_val exclude_interf env (lid:lident) : option<(term * boo let try_lookup_lid (env:env) l = try_lookup_lid' env.iface false env l let try_lookup_datacon env (lid:lident) = - let find_in_sig lid = - match Util.smap_try_find (sigmap env) lid.str with - | Some (Sig_declare_typ(_, _, _, quals, _), _) -> + let k_global_def lid = function + | (Sig_declare_typ(_, _, _, quals, _), _) -> if quals |> Util.for_some (function Assumption -> true | _ -> false) then Some (lid_as_fv lid Delta_constant None) else None - | Some (Sig_datacon _, _) -> Some (lid_as_fv lid Delta_constant (Some Data_ctor)) + | (Sig_datacon _, _) -> Some (lid_as_fv lid Delta_constant (Some Data_ctor)) | _ -> None in - resolve_in_open_namespaces env lid find_in_sig + resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def let find_all_datacons env (lid:lident) = - let find_in_sig lid = - match Util.smap_try_find (sigmap env) lid.str with - | Some (Sig_inductive_typ(_, _, _, _, _, datas, _, _), _) -> Some datas + let k_global_def lid = function + | (Sig_inductive_typ(_, _, _, _, _, datas, _, _), _) -> Some datas | _ -> None in - resolve_in_open_namespaces env lid find_in_sig + resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def //no top-level pattern in F*, so need to do this ugliness let record_cache_aux = @@ -335,7 +498,7 @@ let commit_record_cache = let _, _, _, _, commit = record_cache_aux in commit -let extract_record (e:env) = function +let extract_record (e:env) (new_globs: ref<(list)>) = function | Sig_bundle(sigs, _, _, _) -> let is_rec = Util.for_some (function | RecordType _ @@ -357,12 +520,16 @@ let extract_record (e:env) = function if S.is_null_bv x || (is_rec && S.is_implicit q) then [] - else [(qual constrname (if is_rec then Util.unmangle_field_name x.ppname else x.ppname), x.sort)]) in + else [(mk_field_projector_name_from_ident constrname (if is_rec then Util.unmangle_field_name x.ppname else x.ppname), x.sort)]) in let record = {typename=typename; constrname=constrname; parms=parms; fields=fields; is_record=is_rec} in + (* the record is added to the current list of + top-level definitions, to allow shadowing field names + that were reachable through previous "open"s. *) + let () = new_globs := Record_or_dc record :: !new_globs in insert_record_cache record | _ -> () end @@ -371,24 +538,14 @@ let extract_record (e:env) = function | _ -> () let try_lookup_record_or_dc_by_field_name env (fieldname:lident) = - let maybe_add_constrname ns c = - let rec aux ns = match ns with - | [] -> [c] - | [c'] -> if c'.idText = c.idText then [c] else [c';c] - | hd::tl -> hd::aux tl in - aux ns in + let needs_constrname = not (field_projector_contains_constructor fieldname.ident.idText) in let find_in_cache fieldname = //Util.print_string (Util.format1 "Trying field %s\n" fieldname.str); - let ns, fieldname = fieldname.ns, fieldname.ident in + let ns, id = fieldname.ns, fieldname.ident in Util.find_map (peek_record_cache()) (fun record -> - let constrname = record.constrname.ident in - let ns = maybe_add_constrname ns constrname in - let fname = lid_of_ids (ns@[fieldname]) in - Util.find_map record.fields (fun (f, _) -> - if lid_equals fname f - then Some(record, fname) - else None)) in - resolve_in_open_namespaces env fieldname find_in_cache + option_of_cont (fun _ -> None) (find_in_record ns id record (fun r -> Cont_ok r)) + ) in + resolve_in_open_namespaces'' env fieldname (fun _ -> Cont_ignore) (fun _ -> Cont_ignore) (fun r -> Cont_ok r) (fun k fn -> cont_of_option k (find_in_cache fn)) (fun k _ -> k) let try_lookup_record_by_field_name env (fieldname:lident) = match try_lookup_record_or_dc_by_field_name env fieldname with @@ -404,22 +561,25 @@ let qualify_field_to_record env (recd:record_or_dc) (f:lident) = let qualify fieldname = let ns, fieldname = fieldname.ns, fieldname.ident in let constrname = recd.constrname.ident in - let fname = lid_of_ids (ns@[constrname]@[fieldname]) in + let fname = mk_field_projector_name_from_ident (lid_of_ids (ns @ [constrname])) fieldname in Util.find_map recd.fields (fun (f, _) -> if lid_equals fname f then Some(fname) else None) in - resolve_in_open_namespaces env f qualify + resolve_in_open_namespaces'' env f (fun _ -> Cont_ignore) (fun _ -> Cont_ignore) (fun r -> Cont_ok (snd r)) (fun k fn -> cont_of_option k (qualify fn)) (fun k _ -> k) let unique any_val exclude_if env lid = - let this_env = {env with open_namespaces=[]} in + let this_env = {env with scope_mods=[]} in match try_lookup_lid' any_val exclude_if env lid with | None -> true | Some _ -> false +let push_scope_mod env scope_mod = + {env with scope_mods = scope_mod :: env.scope_mods} + let push_bv' env (x:ident) is_mutable = let bv = S.gen_bv x.idText (Some x.idRange) tun in - {env with localbindings=(x, bv, is_mutable)::env.localbindings}, bv + push_scope_mod env (Local_binding (x, bv, is_mutable)), bv let push_bv_mutable env x = push_bv' env x true @@ -430,7 +590,7 @@ let push_bv env x = let push_top_level_rec_binding env (x:ident) dd = let l = qualify env x in if unique false true env l - then {env with recbindings=(x,l,dd)::env.recbindings} + then push_scope_mod env (Rec_binding (x,l,dd)) else raise (Error ("Duplicate top-level names " ^ l.str, range_of_lid l)) let push_sigelt env s = @@ -444,6 +604,7 @@ let push_sigelt env s = end | None -> "" in raise (Error (Util.format2 "Duplicate top-level names [%s]; previously declared at %s" (text_of_lid l) r, range_of_lid l)) in + let globals = ref env.scope_mods in let env = let any_val, exclude_if = match s with | Sig_let _ -> false, true @@ -451,31 +612,43 @@ let push_sigelt env s = | _ -> false, false in let lids = lids_of_sigelt s in begin match Util.find_map lids (fun l -> if not (unique any_val exclude_if env l) then Some l else None) with - | None -> extract_record env s; {env with sigaccum=s::env.sigaccum} + | None -> extract_record env globals s; {env with sigaccum=s::env.sigaccum} | Some l -> err l end in + let env = {env with scope_mods = !globals} in let env, lss = match s with | Sig_bundle(ses, _, _, _) -> env, List.map (fun se -> (lids_of_sigelt se, se)) ses | _ -> env, [lids_of_sigelt s, s] in lss |> List.iter (fun (lids, se) -> lids |> List.iter (fun lid -> + (* the identifier is added into the list of global + declarations, to allow shadowing of definitions that were + formerly reachable by previous "open"s. *) + let () = globals := Top_level_def lid.ident :: !globals in Util.smap_add (sigmap env) lid.str (se, env.iface && not env.admitted_iface))); + let env = {env with scope_mods = !globals } in env let push_namespace env ns = - let modules = env.modules in - if modules |> Util.for_some (fun (m, _) -> - Util.starts_with (Ident.text_of_lid m) (Ident.text_of_lid ns)) - then {env with open_namespaces = ns::env.open_namespaces} - else raise (Error(Util.format1 "Namespace %s cannot be found" (Ident.text_of_lid ns), Ident.range_of_lid ns)) - -let push_module_abbrev env x l = - if env.modul_abbrevs |> Util.for_some (fun (y, _) -> x.idText=y.idText) - then raise (Error(Util.format1 "Module %s is already defined" x.idText, x.idRange)) - else let modules = env.modules in - if modules |> Util.for_some (fun (m, _) -> Ident.lid_equals m l) - then {env with modul_abbrevs=(x,l)::env.modul_abbrevs} - else raise (Error(Util.format1 "Module %s cannot be found" (Ident.text_of_lid l), Ident.range_of_lid l)) + (* namespace resolution disabled, but module abbrevs enabled *) + let (ns', kd) = match resolve_module_name env ns false with + | None -> + let modules = env.modules in + if modules |> Util.for_some (fun (m, _) -> + Util.starts_with (Ident.text_of_lid m ^ ".") (Ident.text_of_lid ns ^ ".")) + then (ns, Open_namespace) + else raise (Error(Util.format1 "Namespace %s cannot be found" (Ident.text_of_lid ns), Ident.range_of_lid ns)) + | Some ns' -> + (ns', Open_module) + in + push_scope_mod env (Open_module_or_namespace (ns', kd)) + +let push_module_abbrev env x l = + (* both namespace resolution and module abbrevs disabled: + in 'module A = B', B must be fully qualified *) + if module_is_defined env l + then push_scope_mod env (Module_abbrev (x,l)) + else raise (Error(Util.format1 "Module %s cannot be found" (Ident.text_of_lid l), Ident.range_of_lid l)) let check_admits env = env.sigaccum |> List.iter (fun se -> match se with @@ -518,11 +691,9 @@ let finish env modul = {env with curmodule=None; modules=(modul.name, modul)::env.modules; - modul_abbrevs=[]; - open_namespaces=[]; + scope_mods = []; sigaccum=[]; - localbindings=[]; - recbindings=[]} + } type env_stack_ops = { push: env -> env; @@ -608,7 +779,7 @@ let prepare_module_or_interface intf admitted env mname = { env with curmodule=Some mname; sigmap=env.sigmap; - open_namespaces = open_ns; + scope_mods = List.map (fun lid -> Open_module_or_namespace (lid, Open_namespace)) open_ns; iface=intf; admitted_iface=admitted; default_result_effect= @@ -625,38 +796,43 @@ let prepare_module_or_interface intf admitted env mname = prep (push env), true //push a context so that we can pop it when we're done let enter_monad_scope env mname = - let curmod = current_module env in - let mscope = lid_of_ids (curmod.ns@[curmod.ident; mname]) in - {env with - curmodule=Some mscope; - open_namespaces=curmod::env.open_namespaces} - -let exit_monad_scope env0 env = - {env with - curmodule=env0.curmodule; - open_namespaces=env0.open_namespaces} + match env.curmonad with + | Some mname' -> raise (Error ("Trying to define monad " ^ mname.idText ^ ", but already in monad scope " ^ mname'.idText, mname.idRange)) + | None -> {env with curmonad = Some mname} let fail_or env lookup lid = match lookup lid with | None -> let opened_modules = List.map (fun (lid, _) -> text_of_lid lid) env.modules in - let module_of_the_lid = text_of_path (path_of_ns lid.ns) in let msg = Util.format1 "Identifier not found: [%s]" (text_of_lid lid) in let msg = - match env.curmodule with - | Some m when (text_of_lid m = module_of_the_lid || module_of_the_lid = "") -> - (* Lookup in the current module *) - msg - | _ when List.existsb (fun m -> m = module_of_the_lid) opened_modules -> - (* Lookup in a module we've heard about *) - msg - | _ -> - (* Lookup in a module we haven't heard about *) - msg ^ "\n" ^ - Util.format3 "Hint: %s belongs to module %s, which does not belong \ - to the list of modules in scope, namely %s" - (text_of_lid lid) - (text_of_path (path_of_ns lid.ns)) - (String.concat ", " opened_modules) + if List.length lid.ns = 0 + then + msg + else + let modul = set_lid_range (lid_of_ids lid.ns) (range_of_lid lid) in + match resolve_module_name env modul true with + | None -> + let opened_modules = String.concat ", " opened_modules in + Util.format3 + "%s\nModule %s does not belong to the list of modules in scope, namely %s" + msg + modul.str + opened_modules + | Some modul' when (not (List.existsb (fun m -> m = modul'.str) opened_modules)) -> + let opened_modules = String.concat ", " opened_modules in + Util.format4 + "%s\nModule %s resolved into %s, which does not belong to the list of modules in scope, namely %s" + msg + modul.str + modul'.str + opened_modules + | Some modul' -> + Util.format4 + "%s\nModule %s resolved into %s, definition %s not found" + msg + modul.str + modul'.str + lid.ident.idText in raise (Error (msg, range_of_lid lid)) | Some r -> r diff --git a/src/parser/env.fsi b/src/parser/env.fsi index 908010b2196..95b284a6797 100644 --- a/src/parser/env.fsi +++ b/src/parser/env.fsi @@ -31,14 +31,38 @@ open FStar.Ident module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util +type local_binding = (ident * bv * bool) (* local name binding for name resolution, paired with an env-generated unique name and a boolean that is true when the variable has been introduced with let-mutable *) +type rec_binding = (ident * lid * delta_depth) (* name bound by recursive type and top-level let-bindings definitions only *) +type module_abbrev = (ident * lident) (* module X = A.B.C *) + +type open_kind = (* matters only for resolving names with some module qualifier *) +| Open_module (* only opens the module, not the namespace *) +| Open_namespace (* opens the whole namespace *) + +type open_module_or_namespace = (lident * open_kind) (* lident fully qualified name, already resolved. *) + +type record_or_dc = { + typename: lident; + constrname: lident; + parms: binders; + fields: list<(fieldname * typ)>; + is_record:bool +} + +type scope_mod = +| Local_binding of local_binding +| Rec_binding of rec_binding +| Module_abbrev of module_abbrev +| Open_module_or_namespace of open_module_or_namespace +| 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 env = { curmodule: option; (* name of the module being desugared *) + curmonad: option; (* current monad being desugared *) modules: list<(lident * modul)>; (* previously desugared modules *) - open_namespaces: list; (* fully qualified names, in order of precedence *) - modul_abbrevs: list<(ident * lident)>; (* module X = A.B.C *) + scope_mods: list; (* toplevel or definition-local scope modifiers *) sigaccum: sigelts; (* type declarations being accumulated for the current module *) - localbindings: list<(ident * bv * bool)>; (* local name bindings for name resolution, paired with an env-generated unique name and a boolean that is true when the variable has been introduced with let-mutable *) - recbindings: list<(ident*lid*delta_depth)>; (* names bound by recursive type and top-level let-bindings definitions only *) sigmap: Util.smap<(sigelt * bool)>; (* bool indicates that this was declared in an interface file *) default_result_effect:lident; (* either Tot or ML, depending on the what kind of term we're desugaring *) iface: bool; (* remove? whether or not we're desugaring an interface; different scoping rules apply *) @@ -46,13 +70,6 @@ type env = { expect_typ: bool; (* syntactically, expect a type at this position in the term *) } -type record_or_dc = { - typename: lident; - constrname: lident; - parms: binders; - fields: list<(fieldname * typ)>; - is_record:bool -} type foundname = | Term_name of typ * bool // indicates if mutable | Eff_name of sigelt * lident @@ -61,7 +78,6 @@ val fail_or: env -> (lident -> option<'a>) -> lident -> 'a val fail_or2: (ident -> option<'a>) -> ident -> 'a val qualify: env -> ident -> lident -val qualify_lid: env -> lident -> lident val empty_env: unit -> env val default_total: env -> env @@ -87,7 +103,6 @@ val push_top_level_rec_binding: env -> ident -> S.delta_depth -> env val push_sigelt: env -> sigelt -> env val push_namespace: env -> lident -> env val push_module_abbrev : env -> ident -> lident -> env -val expand_module_abbrev: env -> lident -> lident val pop: env -> env val push: env -> env @@ -97,12 +112,9 @@ val commit_mark: env -> env val finish_module_or_interface: env -> modul -> env val prepare_module_or_interface: bool -> bool -> env -> lident -> env * bool //pop the context when done desugaring val enter_monad_scope: env -> ident -> env -val exit_monad_scope: env -> env -> env val export_interface: lident -> env -> env (* private *) val try_lookup_lid': bool -> bool -> env -> lident -> option<(term*bool)> -(* private *) val extract_record: env -> sigelt -> unit (* private *) val unique: bool -> bool -> env -> lident -> bool (* private *) val check_admits: env -> unit (* private *) val finish: env -> modul -> env -(* private *) val resolve_in_open_namespaces: env -> lident -> (lident -> option<'a>) -> option<'a> diff --git a/src/parser/lex.fsl b/src/parser/lex.fsl index 47ca99533be..295f9da5fd8 100644 --- a/src/parser/lex.fsl +++ b/src/parser/lex.fsl @@ -363,6 +363,8 @@ rule token args = parse | "<==>" { IFF } | "==>" { IMPLIES } | "." { DOT } + | "?." { QMARK_DOT } + | "?" { QMARK } | ".[" { DOT_LBRACK } | ".(" { DOT_LPAREN } | "{:pattern" { LBRACE_COLON_PATTERN } diff --git a/src/parser/ml/lex.mll b/src/parser/ml/lex.mll index 8e666dda57f..091dd2cb589 100644 --- a/src/parser/ml/lex.mll +++ b/src/parser/ml/lex.mll @@ -326,6 +326,8 @@ rule token = parse | "<==>" { IFF } | "==>" { IMPLIES } | "." { DOT } + | "?." { QMARK_DOT } + | "?" { QMARK } | ".[" { DOT_LBRACK } | ".(" { DOT_LPAREN } | "{:pattern" { LBRACE_COLON_PATTERN } diff --git a/src/parser/ml/parse.mly b/src/parser/ml/parse.mly index 4a159aabb12..ed29075539b 100644 --- a/src/parser/ml/parse.mly +++ b/src/parser/ml/parse.mly @@ -196,6 +196,8 @@ let compile_op arity s = %token PRAGMA_RESET_OPTIONS %token PRAGMA_SET_OPTIONS %token PRIVATE +%token QMARK +%token QMARK_DOT %token RARROW %token RBRACE %token RBRACK @@ -312,19 +314,6 @@ let x = in ( Some x )} -option___anonymous_8_: - - { ( None )} -| TYP_APP_LESS separated_nonempty_list_COMMA_atomicTerm_ TYP_APP_GREATER - {let (_10, targs0, _30) = ((), $2, ()) in -let x = - let _3 = _30 in - let targs = targs0 in - let _1 = _10 in - (targs) -in - ( Some x )} - option_ascribeKind_: { ( None )} @@ -339,6 +328,13 @@ option_ascribeTyp_: {let x = $1 in ( Some x )} +option_fsTypeArgs_: + + { ( None )} +| fsTypeArgs + {let x = $1 in + ( Some x )} + option_mainDecl_: { ( None )} @@ -453,28 +449,6 @@ list_decl_: {let (x, xs) = ($1, $2) in ( x :: xs )} -list_dotOperator_: - - { ( [] )} -| DOT_LPAREN term RPAREN list_dotOperator_ - {let (_10, e0, _30, xs) = ((), $2, (), $4) in -let x = - let _3 = _30 in - let e = e0 in - let _1 = _10 in - ( ".()", e, rhs2 parseState 1 3 ) -in - ( x :: xs )} -| DOT_LBRACK term RBRACK list_dotOperator_ - {let (_10, e0, _30, xs) = ((), $2, (), $4) in -let x = - let _3 = _30 in - let e = e0 in - let _1 = _10 in - ( ".[]", e, rhs2 parseState 1 3 ) -in - ( x :: xs )} - list_multiBinder_: { ( [] )} @@ -539,6 +513,44 @@ nonempty_list_atomicPattern_: {let (x, xs) = ($1, $2) in ( x :: xs )} +nonempty_list_dotOperator_: + DOT_LPAREN term RPAREN + {let (_10, e0, _30) = ((), $2, ()) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".()", e, rhs2 parseState 1 3 ) +in + ( [ x ] )} +| DOT_LBRACK term RBRACK + {let (_10, e0, _30) = ((), $2, ()) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".[]", e, rhs2 parseState 1 3 ) +in + ( [ x ] )} +| DOT_LPAREN term RPAREN nonempty_list_dotOperator_ + {let (_10, e0, _30, xs) = ((), $2, (), $4) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".()", e, rhs2 parseState 1 3 ) +in + ( x :: xs )} +| DOT_LBRACK term RBRACK nonempty_list_dotOperator_ + {let (_10, e0, _30, xs) = ((), $2, (), $4) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".[]", e, rhs2 parseState 1 3 ) +in + ( x :: xs )} + nonempty_list_patternOrMultibinder_: patternOrMultibinder {let x = $1 in @@ -1333,19 +1345,6 @@ quident: {let ids = $1 in ( lid_of_ids ids )} -qident: - path_ident_ - {let ids = $1 in - ( lid_of_ids ids )} - -path_ident_: - ident - {let id = $1 in - ( [id] )} -| uident DOT path_ident_ - {let (uid, _2, p) = ($1, (), $3) in - ( uid::p )} - path_lident_: lident {let id = $1 in @@ -1515,7 +1514,7 @@ noSeqTerm: | tmIff SUBTYPE typ {let (e, _2, t) = ($1, (), $3) in ( mk_term (Ascribed(e,{t with level=Expr})) (rhs2 parseState 1 3) Expr )} -| atomicTerm DOT_LPAREN term RPAREN LARROW noSeqTerm +| atomicTermNotQUident DOT_LPAREN term RPAREN LARROW noSeqTerm {let (e1, _10, e0, _30, _3, e3) = ($1, (), $3, (), (), $6) in let op_expr = let _3 = _30 in @@ -1527,7 +1526,7 @@ in let (op, e2, _) = op_expr in mk_term (Op(op ^ "<-", [ e1; e2; e3 ])) (rhs2 parseState 1 6) Expr )} -| atomicTerm DOT_LBRACK term RBRACK LARROW noSeqTerm +| atomicTermNotQUident DOT_LBRACK term RBRACK LARROW noSeqTerm {let (e1, _10, e0, _30, _3, e3) = ($1, (), $3, (), (), $6) in let op_expr = let _3 = _30 in @@ -1977,15 +1976,43 @@ appTerm: ( mkApp head (map (fun (x,y) -> (y,x)) args) (rhs2 parseState 1 2) )} indexingTerm: - atomicTerm list_dotOperator_ + atomicTermNotQUident nonempty_list_dotOperator_ {let (e1, op_exprs) = ($1, $2) in ( List.fold_left (fun e1 (op, e2, r) -> mk_term (Op(op, [ e1; e2 ])) (union_ranges e1.range r) Expr) e1 op_exprs )} +| atomicTerm + {let e = $1 in + ( e )} atomicTerm: + atomicTermNotQUident + {let x = $1 in + ( x )} +| atomicTermQUident + {let x = $1 in + ( x )} +| opPrefixTerm_atomicTermQUident_ + {let x = $1 in + ( x )} + +atomicTermQUident: + quident + {let id = $1 in + ( + let t = Name id in + let e = mk_term t (rhs parseState 1) Un in + e + )} +| quident DOT_LPAREN term RPAREN + {let (id, _2, t, _4) = ($1, (), $3, ()) in + ( + mk_term (LetOpen (id, t)) (rhs2 parseState 1 4) Expr + )} + +atomicTermNotQUident: UNDERSCORE {let _1 = () in ( mk_term Wild (rhs parseState 1) Un )} @@ -2004,9 +2031,9 @@ atomicTerm: | L_FALSE {let _1 = () in ( mk_term (Name (lid_of_path ["False"] (rhs parseState 1))) (rhs parseState 1) Type )} -| OPPREFIX atomicTerm - {let (op, e) = ($1, $2) in - ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} +| opPrefixTerm_atomicTermNotQUident_ + {let x = $1 in + ( x )} | LPAREN OPPREFIX RPAREN {let (_1, op0, _3) = ((), $2, ()) in let op = @@ -2104,8 +2131,39 @@ in {let (_1, e, _3) = ((), $2, ()) in ( e )} -projectionLHS: - qident option___anonymous_8_ +opPrefixTerm_atomicTermNotQUident_: + OPPREFIX atomicTermNotQUident + {let (op, e) = ($1, $2) in + ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} + +opPrefixTerm_atomicTermQUident_: + OPPREFIX atomicTermQUident + {let (op, e) = ($1, $2) in + ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} + +fsTypeArgs: + TYP_APP_LESS separated_nonempty_list_COMMA_atomicTerm_ TYP_APP_GREATER + {let (_1, targs, _3) = ((), $2, ()) in + (targs)} + +someFsTypeArgs: + fsTypeArgs + {let targs = $1 in + ( Some targs )} + +qidentWithTypeArgs_qlident_option_fsTypeArgs__: + qlident option_fsTypeArgs_ + {let (id, targs_opt) = ($1, $2) in + ( + let t = if is_name id then Name id else Var id in + let e = mk_term t (rhs parseState 1) Un in + match targs_opt with + | None -> e + | Some targs -> mkFsTypApp e targs (rhs2 parseState 1 2) + )} + +qidentWithTypeArgs_quident_someFsTypeArgs_: + quident someFsTypeArgs {let (id, targs_opt) = ($1, $2) in ( let t = if is_name id then Name id else Var id in @@ -2114,6 +2172,14 @@ projectionLHS: | None -> e | Some targs -> mkFsTypApp e targs (rhs2 parseState 1 2) )} + +projectionLHS: + qidentWithTypeArgs_qlident_option_fsTypeArgs__ + {let e = $1 in + ( e )} +| qidentWithTypeArgs_quident_someFsTypeArgs_ + {let e = $1 in + ( e )} | LPAREN term option_pair_hasSort_simpleTerm__ RPAREN {let (_1, e, sort_opt, _4) = ((), $2, $3, ()) in ( @@ -2154,6 +2220,18 @@ let es = ( xs ) in ( mkRefSet (rhs2 parseState 1 3) es )} +| quident QMARK_DOT lident + {let (ns, _2, id) = ($1, (), $3) in + ( + mk_term (Projector (ns, id)) (rhs2 parseState 1 3) Expr + )} +| quident QMARK + {let (lid, _2) = ($1, ()) in + ( + let t = Discrim lid in + let e = mk_term t (rhs parseState 1) Un in + e + )} hasSort: SUBKIND diff --git a/src/parser/parse.fsi b/src/parser/parse.fsi index c4d034f9c9b..6df7866b576 100755 --- a/src/parser/parse.fsi +++ b/src/parser/parse.fsi @@ -38,6 +38,8 @@ type token = | RBRACK | RBRACE | RARROW + | QMARK_DOT + | QMARK | PRIVATE | PRAGMA_SET_OPTIONS | PRAGMA_RESET_OPTIONS @@ -169,6 +171,8 @@ type tokenId = | TOKEN_RBRACK | TOKEN_RBRACE | TOKEN_RARROW + | TOKEN_QMARK_DOT + | TOKEN_QMARK | TOKEN_PRIVATE | TOKEN_PRAGMA_SET_OPTIONS | TOKEN_PRAGMA_RESET_OPTIONS @@ -273,9 +277,9 @@ type nonTerminalId = | NONTERM_option___anonymous_1_ | NONTERM_option___anonymous_2_ | NONTERM_option___anonymous_6_ - | NONTERM_option___anonymous_8_ | NONTERM_option_ascribeKind_ | NONTERM_option_ascribeTyp_ + | NONTERM_option_fsTypeArgs_ | NONTERM_option_mainDecl_ | NONTERM_option_pair_hasSort_simpleTerm__ | NONTERM_option_string_ @@ -288,13 +292,13 @@ type nonTerminalId = | NONTERM_list___anonymous_7_ | NONTERM_list_constructorDecl_ | NONTERM_list_decl_ - | NONTERM_list_dotOperator_ | NONTERM_list_multiBinder_ | NONTERM_list_pair_maybeHash_indexingTerm__ | NONTERM_list_qualifier_ | NONTERM_nonempty_list_aqualified_lident__ | NONTERM_nonempty_list_aqualified_lidentOrUnderscore__ | NONTERM_nonempty_list_atomicPattern_ + | NONTERM_nonempty_list_dotOperator_ | NONTERM_nonempty_list_patternOrMultibinder_ | NONTERM_separated_nonempty_list_AND_letbinding_ | NONTERM_separated_nonempty_list_AND_pair_option_FSDOC__typeDecl__ @@ -346,8 +350,6 @@ type nonTerminalId = | NONTERM_aqualified_lidentOrUnderscore_ | NONTERM_qlident | NONTERM_quident - | NONTERM_qident - | NONTERM_path_ident_ | NONTERM_path_lident_ | NONTERM_path_uident_ | NONTERM_ident @@ -383,6 +385,14 @@ type nonTerminalId = | NONTERM_appTerm | NONTERM_indexingTerm | NONTERM_atomicTerm + | NONTERM_atomicTermQUident + | NONTERM_atomicTermNotQUident + | NONTERM_opPrefixTerm_atomicTermNotQUident_ + | NONTERM_opPrefixTerm_atomicTermQUident_ + | NONTERM_fsTypeArgs + | NONTERM_someFsTypeArgs + | NONTERM_qidentWithTypeArgs_qlident_option_fsTypeArgs__ + | NONTERM_qidentWithTypeArgs_quident_someFsTypeArgs_ | NONTERM_projectionLHS | NONTERM_hasSort | NONTERM_constant diff --git a/src/parser/parse.fsy b/src/parser/parse.fsy index ba17531abde..c33ee4ed21f 100644 --- a/src/parser/parse.fsy +++ b/src/parser/parse.fsy @@ -198,6 +198,8 @@ let compile_op arity s = %token PRAGMA_RESET_OPTIONS %token PRAGMA_SET_OPTIONS %token PRIVATE +%token QMARK +%token QMARK_DOT %token RARROW %token RBRACE %token RBRACK @@ -314,19 +316,6 @@ let x = in ( Some x )} -option___anonymous_8_: - - { ( None )} -| TYP_APP_LESS separated_nonempty_list_COMMA_atomicTerm_ TYP_APP_GREATER - {let (_10, targs0, _30) = ((), $2, ()) in -let x = - let _3 = _30 in - let targs = targs0 in - let _1 = _10 in - (targs) -in - ( Some x )} - option_ascribeKind_: { ( None )} @@ -341,6 +330,13 @@ option_ascribeTyp_: {let x = $1 in ( Some x )} +option_fsTypeArgs_: + + { ( None )} +| fsTypeArgs + {let x = $1 in + ( Some x )} + option_mainDecl_: { ( None )} @@ -455,28 +451,6 @@ list_decl_: {let (x, xs) = ($1, $2) in ( x :: xs )} -list_dotOperator_: - - { ( [] )} -| DOT_LPAREN term RPAREN list_dotOperator_ - {let (_10, e0, _30, xs) = ((), $2, (), $4) in -let x = - let _3 = _30 in - let e = e0 in - let _1 = _10 in - ( ".()", e, rhs2 parseState 1 3 ) -in - ( x :: xs )} -| DOT_LBRACK term RBRACK list_dotOperator_ - {let (_10, e0, _30, xs) = ((), $2, (), $4) in -let x = - let _3 = _30 in - let e = e0 in - let _1 = _10 in - ( ".[]", e, rhs2 parseState 1 3 ) -in - ( x :: xs )} - list_multiBinder_: { ( [] )} @@ -541,6 +515,44 @@ nonempty_list_atomicPattern_: {let (x, xs) = ($1, $2) in ( x :: xs )} +nonempty_list_dotOperator_: + DOT_LPAREN term RPAREN + {let (_10, e0, _30) = ((), $2, ()) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".()", e, rhs2 parseState 1 3 ) +in + ( [ x ] )} +| DOT_LBRACK term RBRACK + {let (_10, e0, _30) = ((), $2, ()) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".[]", e, rhs2 parseState 1 3 ) +in + ( [ x ] )} +| DOT_LPAREN term RPAREN nonempty_list_dotOperator_ + {let (_10, e0, _30, xs) = ((), $2, (), $4) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".()", e, rhs2 parseState 1 3 ) +in + ( x :: xs )} +| DOT_LBRACK term RBRACK nonempty_list_dotOperator_ + {let (_10, e0, _30, xs) = ((), $2, (), $4) in +let x = + let _3 = _30 in + let e = e0 in + let _1 = _10 in + ( ".[]", e, rhs2 parseState 1 3 ) +in + ( x :: xs )} + nonempty_list_patternOrMultibinder_: patternOrMultibinder {let x = $1 in @@ -1335,19 +1347,6 @@ quident: {let ids = $1 in ( lid_of_ids ids )} -qident: - path_ident_ - {let ids = $1 in - ( lid_of_ids ids )} - -path_ident_: - ident - {let id = $1 in - ( [id] )} -| uident DOT path_ident_ - {let (uid, _2, p) = ($1, (), $3) in - ( uid::p )} - path_lident_: lident {let id = $1 in @@ -1517,7 +1516,7 @@ noSeqTerm: | tmIff SUBTYPE typ {let (e, _2, t) = ($1, (), $3) in ( mk_term (Ascribed(e,{t with level=Expr})) (rhs2 parseState 1 3) Expr )} -| atomicTerm DOT_LPAREN term RPAREN LARROW noSeqTerm +| atomicTermNotQUident DOT_LPAREN term RPAREN LARROW noSeqTerm {let (e1, _10, e0, _30, _3, e3) = ($1, (), $3, (), (), $6) in let op_expr = let _3 = _30 in @@ -1529,7 +1528,7 @@ in let (op, e2, _) = op_expr in mk_term (Op(op ^ "<-", [ e1; e2; e3 ])) (rhs2 parseState 1 6) Expr )} -| atomicTerm DOT_LBRACK term RBRACK LARROW noSeqTerm +| atomicTermNotQUident DOT_LBRACK term RBRACK LARROW noSeqTerm {let (e1, _10, e0, _30, _3, e3) = ($1, (), $3, (), (), $6) in let op_expr = let _3 = _30 in @@ -1979,15 +1978,43 @@ appTerm: ( mkApp head (map (fun (x,y) -> (y,x)) args) (rhs2 parseState 1 2) )} indexingTerm: - atomicTerm list_dotOperator_ + atomicTermNotQUident nonempty_list_dotOperator_ {let (e1, op_exprs) = ($1, $2) in ( List.fold_left (fun e1 (op, e2, r) -> mk_term (Op(op, [ e1; e2 ])) (union_ranges e1.range r) Expr) e1 op_exprs )} +| atomicTerm + {let e = $1 in + ( e )} atomicTerm: + atomicTermNotQUident + {let x = $1 in + ( x )} +| atomicTermQUident + {let x = $1 in + ( x )} +| opPrefixTerm_atomicTermQUident_ + {let x = $1 in + ( x )} + +atomicTermQUident: + quident + {let id = $1 in + ( + let t = Name id in + let e = mk_term t (rhs parseState 1) Un in + e + )} +| quident DOT_LPAREN term RPAREN + {let (id, _2, t, _4) = ($1, (), $3, ()) in + ( + mk_term (LetOpen (id, t)) (rhs2 parseState 1 4) Expr + )} + +atomicTermNotQUident: UNDERSCORE {let _1 = () in ( mk_term Wild (rhs parseState 1) Un )} @@ -2006,9 +2033,9 @@ atomicTerm: | L_FALSE {let _1 = () in ( mk_term (Name (lid_of_path ["False"] (rhs parseState 1))) (rhs parseState 1) Type )} -| OPPREFIX atomicTerm - {let (op, e) = ($1, $2) in - ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} +| opPrefixTerm_atomicTermNotQUident_ + {let x = $1 in + ( x )} | LPAREN OPPREFIX RPAREN {let (_1, op0, _3) = ((), $2, ()) in let op = @@ -2106,8 +2133,39 @@ in {let (_1, e, _3) = ((), $2, ()) in ( e )} -projectionLHS: - qident option___anonymous_8_ +opPrefixTerm_atomicTermNotQUident_: + OPPREFIX atomicTermNotQUident + {let (op, e) = ($1, $2) in + ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} + +opPrefixTerm_atomicTermQUident_: + OPPREFIX atomicTermQUident + {let (op, e) = ($1, $2) in + ( mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr )} + +fsTypeArgs: + TYP_APP_LESS separated_nonempty_list_COMMA_atomicTerm_ TYP_APP_GREATER + {let (_1, targs, _3) = ((), $2, ()) in + (targs)} + +someFsTypeArgs: + fsTypeArgs + {let targs = $1 in + ( Some targs )} + +qidentWithTypeArgs_qlident_option_fsTypeArgs__: + qlident option_fsTypeArgs_ + {let (id, targs_opt) = ($1, $2) in + ( + let t = if is_name id then Name id else Var id in + let e = mk_term t (rhs parseState 1) Un in + match targs_opt with + | None -> e + | Some targs -> mkFsTypApp e targs (rhs2 parseState 1 2) + )} + +qidentWithTypeArgs_quident_someFsTypeArgs_: + quident someFsTypeArgs {let (id, targs_opt) = ($1, $2) in ( let t = if is_name id then Name id else Var id in @@ -2116,6 +2174,14 @@ projectionLHS: | None -> e | Some targs -> mkFsTypApp e targs (rhs2 parseState 1 2) )} + +projectionLHS: + qidentWithTypeArgs_qlident_option_fsTypeArgs__ + {let e = $1 in + ( e )} +| qidentWithTypeArgs_quident_someFsTypeArgs_ + {let e = $1 in + ( e )} | LPAREN term option_pair_hasSort_simpleTerm__ RPAREN {let (_1, e, sort_opt, _4) = ((), $2, $3, ()) in ( @@ -2156,6 +2222,18 @@ let es = ( xs ) in ( mkRefSet (rhs2 parseState 1 3) es )} +| quident QMARK_DOT lident + {let (ns, _2, id) = ($1, (), $3) in + ( + mk_term (Projector (ns, id)) (rhs2 parseState 1 3) Expr + )} +| quident QMARK + {let (lid, _2) = ($1, ()) in + ( + let t = Discrim lid in + let e = mk_term t (rhs parseState 1) Un in + e + )} hasSort: SUBKIND diff --git a/src/parser/parse.mly b/src/parser/parse.mly index 3528223aed9..d88c0c58a3c 100644 --- a/src/parser/parse.mly +++ b/src/parser/parse.mly @@ -136,6 +136,8 @@ let compile_op arity s = %token WHEN WITH HASH AMP LPAREN RPAREN LPAREN_RPAREN COMMA LARROW RARROW %token IFF IMPLIES CONJUNCTION DISJUNCTION %token DOT COLON COLON_COLON SEMICOLON +%token QMARK_DOT +%token QMARK %token SEMICOLON_SEMICOLON EQUALS PERCENT_LBRACK DOT_LBRACK DOT_LPAREN LBRACK LBRACK_BAR LBRACE BANG_LBRACE %token BAR_RBRACK UNDERSCORE LENS_PAREN_LEFT LENS_PAREN_RIGHT %token BAR RBRACK RBRACE DOLLAR @@ -524,9 +526,6 @@ qlident: quident: | ids=path(uident) { lid_of_ids ids } -qident: - | ids=path(ident) { lid_of_ids ids } - path(Id): | id=Id { [id] } | uid=uident DOT p=path(Id) { uid::p } @@ -586,7 +585,7 @@ noSeqTerm: | t=typ { t } | e=tmIff SUBTYPE t=typ { mk_term (Ascribed(e,{t with level=Expr})) (rhs2 parseState 1 3) Expr } - | e1=atomicTerm op_expr=dotOperator LARROW e3=noSeqTerm + | e1=atomicTermNotQUident op_expr=dotOperator LARROW e3=noSeqTerm { let (op, e2, _) = op_expr in mk_term (Op(op ^ "<-", [ e1; e2; e3 ])) (rhs2 parseState 1 6) Expr @@ -802,22 +801,44 @@ appTerm: | HASH { Hash } indexingTerm: - | e1=atomicTerm op_exprs=list(dotOperator) + | e1=atomicTermNotQUident op_exprs=nonempty_list(dotOperator) { List.fold_left (fun e1 (op, e2, r) -> mk_term (Op(op, [ e1; e2 ])) (union_ranges e1.range r) Expr) e1 op_exprs } + | e=atomicTerm + { e } atomicTerm: + | x=atomicTermNotQUident + { x } + | x=atomicTermQUident + { x } + | x=opPrefixTerm(atomicTermQUident) + { x } + +atomicTermQUident: + | id=quident + { + let t = Name id in + let e = mk_term t (rhs parseState 1) Un in + e + } + | id=quident DOT_LPAREN t=term RPAREN + { + mk_term (LetOpen (id, t)) (rhs2 parseState 1 4) Expr + } + +atomicTermNotQUident: | UNDERSCORE { mk_term Wild (rhs parseState 1) Un } | ASSERT { mk_term (Var assert_lid) (rhs parseState 1) Expr } | tv=tvar { mk_term (Tvar tv) (rhs parseState 1) Type } | c=constant { mk_term (Const c) (rhs parseState 1) Expr } | L_TRUE { mk_term (Name (lid_of_path ["True"] (rhs parseState 1))) (rhs parseState 1) Type } | L_FALSE { mk_term (Name (lid_of_path ["False"] (rhs parseState 1))) (rhs parseState 1) Type } - | op=OPPREFIX e=atomicTerm - { mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr } + | x=opPrefixTerm(atomicTermNotQUident) + { x } | LPAREN op=operator RPAREN { mk_term (Op(op, [])) (rhs2 parseState 1 3) Un } | LENS_PAREN_LEFT e0=tmEq COMMA el=separated_nonempty_list(COMMA, tmEq) LENS_PAREN_RIGHT @@ -827,9 +848,23 @@ atomicTerm: | BEGIN e=term END { e } +(* Tm: atomicTermQUident or atomicTermNotQUident *) +opPrefixTerm(Tm): + | op=OPPREFIX e=Tm + { mk_term (Op(op, [e])) (rhs2 parseState 1 3) Expr } + +fsTypeArgs: + | TYP_APP_LESS targs=separated_nonempty_list(COMMA, atomicTerm) TYP_APP_GREATER + {targs} -projectionLHS: - | id=qident targs_opt=option(TYP_APP_LESS targs=separated_nonempty_list(COMMA, atomicTerm) TYP_APP_GREATER {targs}) +someFsTypeArgs: + | targs=fsTypeArgs + { Some targs } + +(* Qid : quident or qlident. + TypeArgs : option(fsTypeArgs) or someFsTypeArgs. *) +qidentWithTypeArgs(Qid,TypeArgs): + | id=Qid targs_opt=TypeArgs { let t = if is_name id then Name id else Var id in let e = mk_term t (rhs parseState 1) Un in @@ -837,6 +872,12 @@ projectionLHS: | None -> e | Some targs -> mkFsTypApp e targs (rhs2 parseState 1 2) } + +projectionLHS: + | e=qidentWithTypeArgs(qlident,option(fsTypeArgs)) + { e } + | e=qidentWithTypeArgs(quident,someFsTypeArgs) + { e } | LPAREN e=term sort_opt=option(pair(hasSort, simpleTerm)) RPAREN { let e1 = match sort_opt with @@ -856,6 +897,16 @@ projectionLHS: { mkLexList (rhs2 parseState 1 3) es } | BANG_LBRACE es=separated_list(COMMA, appTerm) RBRACE { mkRefSet (rhs2 parseState 1 3) es } + | ns=quident QMARK_DOT id=lident + { + mk_term (Projector (ns, id)) (rhs2 parseState 1 3) Expr + } + | lid=quident QMARK + { + let t = Discrim lid in + let e = mk_term t (rhs parseState 1) Un in + e + } hasSort: (* | SUBTYPE { Expr } *) diff --git a/src/parser/tosyntax.fs b/src/parser/tosyntax.fs index 9b889a95739..cd40a3294ac 100644 --- a/src/parser/tosyntax.fs +++ b/src/parser/tosyntax.fs @@ -38,7 +38,7 @@ let trans_aqual = function | Some AST.Equality -> Some S.Equality | _ -> None -let trans_qual r = function +let trans_qual r maybe_effect_id = function | AST.Private -> S.Private | AST.Assumption -> S.Assumption | AST.Unfold_for_unification_and_vcgen -> S.Unfold_for_unification_and_vcgen @@ -50,7 +50,11 @@ let trans_qual r = function | AST.New -> S.New | AST.Abstract -> S.Abstract | AST.Opaque -> FStar.TypeChecker.Errors.warn r "The 'opaque' qualifier is deprecated since its use was strangely schizophrenic. There were two overloaded uses: (1) Given 'opaque val f : t', the behavior was to exclude the definition of 'f' to the SMT solver. This corresponds roughly to the new 'irreducible' qualifier. (2) Given 'opaque type t = t'', the behavior was to provide the definition of 't' to the SMT solver, but not to inline it, unless absolutely required for unification. This corresponds roughly to the behavior of 'unfoldable' (which is currently the default)."; S.Visible_default - | AST.Reflectable -> S.Reflectable + | AST.Reflectable -> + begin match maybe_effect_id with + | None -> raise (Error ("Qualifier reflect only supported on effects", r)) + | Some effect_id -> S.Reflectable effect_id + end | AST.Reifiable -> S.Reifiable | AST.Noeq -> S.Noeq | AST.Unopteq -> S.Unopteq @@ -194,6 +198,8 @@ and free_type_vars env t = match (unparen t).tm with | Wild | Const _ | Var _ + | Projector _ + | Discrim _ | Name _ -> [] | Assign (_, t) @@ -521,6 +527,12 @@ and desugar_machine_integer env repr (signedness, width) range = let repr = S.mk (Tm_constant (Const_int (repr, None))) None range in S.mk (Tm_app (lid, [repr, as_implicit false])) None range +and desugar_name mk setpos (env: env_t) (l: lid) : S.term = + let tm, mut = fail_or env (Env.try_lookup_lid env) l in + let tm = setpos tm in + if mut then mk <| Tm_meta (mk_ref_read tm, Meta_desugared Mutable_rval) + else tm + and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = let mk e = S.mk e None top.range in let setpos e = {e with pos=top.range} in @@ -572,9 +584,9 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = | Name {str="Effect"} -> mk (Tm_constant Const_effect) | Name {str="True"} -> S.fvar (Ident.set_lid_range Const.true_lid top.range) Delta_constant None | Name {str="False"} -> S.fvar (Ident.set_lid_range Const.false_lid top.range) Delta_constant None - | Var {ident={idText = txt}; ns = eff :: rest } - when is_special_effect_combinator txt && Env.is_effect_name env (lid_of_ids (eff :: rest)) -> - begin match try_lookup_effect_defn env (lid_of_ids (eff :: rest)) with + | Projector (eff_name, {idText = txt}) + when is_special_effect_combinator txt && Env.is_effect_name env eff_name -> + begin match try_lookup_effect_defn env eff_name with | Some ed -> S.fvar (lid_of_path (path_of_text (text_of_lid ed.mname ^ "_" ^ txt)) Range.dummyRange) (Delta_defined_at_level 1) None | None -> @@ -590,10 +602,25 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = | Var l | Name l -> - let tm, mut = fail_or env (Env.try_lookup_lid env) l in - let tm = setpos tm in - if mut then mk <| Tm_meta (mk_ref_read tm, Meta_desugared Mutable_rval) - else tm + desugar_name mk setpos env l + + | Projector (l, i) -> + let found = + Option.isSome (Env.try_lookup_datacon env l) || + Option.isSome (Env.try_lookup_effect_defn env l) + in + if found + then desugar_name mk setpos env (mk_field_projector_name_from_ident l i) + else raise (Error (Util.format1 "Data constructor or effect %s not found" l.str, top.range)) + + | Discrim lid -> + begin match Env.try_lookup_datacon env lid with + | None -> + raise (Error (Util.format1 "Data constructor %s not found" lid.str, top.range)) + | _ -> + let lid' = Util.mk_discriminator lid in + desugar_name mk setpos env lid' + end | Construct(l, args) -> begin match Env.try_lookup_datacon env l with @@ -611,13 +638,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = else app end | None -> - let l = Env.expand_module_abbrev env l in - let env = Env.push_namespace env l in - match args with - | [ (e, _) ] -> - desugar_term_maybe_top top_level env e - | _ -> - raise (Error("The Foo.Bar (...) local open takes exactly one argument", top.range)) + raise (Error ("Constructor " ^ l.str ^ " not found", top.range)) end | Sum(binders, t) -> @@ -733,7 +754,6 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = Meta_desugared Sequence)) | LetOpen (lid, e) -> - let lid = Env.expand_module_abbrev env lid in let env = Env.push_namespace env lid in desugar_term_maybe_top top_level env e @@ -872,21 +892,18 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = | Record(eopt, fields) -> let f, _ = List.hd fields in - let qfn g = lid_of_ids (f.ns@[g]) in let record, _ = fail_or env (try_lookup_record_by_field_name env) f in + let fields' = fields |> List.map (fun (f, e) -> (mk_field_projector_name_from_ident record.constrname f.ident, e)) in let get_field xopt f = - let fn = f.ident in - let found = fields |> Util.find_opt (fun (g, _) -> - let gn = g.ident in - fn.idText = gn.idText) in + let found = fields' |> Util.find_opt (fun (g, _) -> lid_equals f g) in match found with - | Some (_, e) -> qfn fn, e + | Some (_, e) -> (f, e) | None -> match xopt with | None -> raise (Error (Util.format1 "Field %s is missing" (text_of_lid f), top.range)) | Some x -> - qfn fn, mk_term (Project(x, f)) x.range x.level in + (f, mk_term (Project(x, f)) x.range x.level) in let recterm = match eopt with | None -> @@ -914,9 +931,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term = | Project(e, f) -> let fieldname, is_rec = fail_or env (try_lookup_projector_by_field_name env) f in let e = desugar_term env e in - let fn = - let ns, _ = Util.prefix fieldname.ns in - lid_of_ids (ns@[f.ident]) in + let fn = fieldname in let qual = if is_rec then Some (Record_projector fn) else None in mk <| Tm_app(S.fvar (Ident.set_lid_range fieldname (range_of_lid f)) Delta_equational qual, [as_arg e]) @@ -1456,6 +1471,7 @@ let rec desugar_effect env d (quals: qualifiers) eff_name eff_binders eff_kind e // the definition and its cps'd type. { action_name=Env.qualify env name; + action_unqualified_name = name; action_univs=[]; action_defn=Subst.close binders (desugar_term env def); action_typ=Subst.close binders (desugar_typ env cps_type) @@ -1465,6 +1481,7 @@ let rec desugar_effect env d (quals: qualifiers) eff_name eff_binders eff_kind e // is elaborated { action_name=Env.qualify env name; + action_unqualified_name = name; action_univs=[]; action_defn=Subst.close binders (desugar_term env defn); action_typ=S.tun @@ -1481,7 +1498,7 @@ let rec desugar_effect env d (quals: qualifiers) eff_name eff_binders eff_kind e let l = Env.qualify env (mk_ident(s, d.drange)) in [], Subst.close binders <| fail_or env (try_lookup_definition env) l in let mname =qualify env0 eff_name in - let qualifiers =List.map (trans_qual d.drange) quals in + let qualifiers =List.map (trans_qual d.drange (Some mname)) quals in let se = if for_free then let dummy_tscheme = [], mk Tm_unknown None Range.dummyRange in @@ -1508,7 +1525,7 @@ let rec desugar_effect env d (quals: qualifiers) eff_name eff_binders eff_kind e }, d.drange) else let rr = qualifiers |> List.contains S.Reifiable - || qualifiers |> List.contains S.Reflectable in + || qualifiers |> S.contains_reflectable in let un_ts = [], Syntax.tun in Sig_new_effect({ mname = mname; @@ -1539,7 +1556,7 @@ let rec desugar_effect env d (quals: qualifiers) eff_name eff_binders eff_kind e let env = if quals |> List.contains Reflectable then let reflect_lid = Ident.id_of_text "reflect" |> Env.qualify monad_env in - let refl_decl = S.Sig_declare_typ(reflect_lid, [], S.tun, [S.Assumption; S.Reflectable], d.drange) in + let refl_decl = S.Sig_declare_typ(reflect_lid, [], S.tun, [S.Assumption; S.Reflectable mname], d.drange) in push_sigelt env refl_decl else env in env, [se] @@ -1561,9 +1578,10 @@ and desugar_redefine_effect env d trans_qual quals eff_name eff_binders defn bui then raise (Error("Unexpected number of arguments to effect constructor", defn.range)); let s = Util.subst_of_list edb args in [], Subst.close binders (Subst.subst s x) in + let mname=qualify env0 eff_name in let ed = { - mname=qualify env0 eff_name; - qualifiers =List.map trans_qual quals; + mname =mname; + qualifiers =List.map (trans_qual (Some mname)) quals; univs =[]; binders =binders; signature =snd (sub ([], ed.signature)); @@ -1584,8 +1602,9 @@ and desugar_redefine_effect env d trans_qual quals eff_name eff_binders defn bui actions = List.map (fun action -> { // Since we called enter_monad_env before, this is going to generate - // a name of the form FStar.ST.STATE.get - action_name = Env.qualify env action.action_name.ident; + // a name of the form FStar.ST.uu___proj__STATE__item__get + action_name = Env.qualify env (action.action_unqualified_name); + action_unqualified_name = action.action_unqualified_name; action_univs = action.action_univs ; action_defn =snd (sub ([], action.action_defn)) ; action_typ =snd (sub ([], action.action_typ)) @@ -1601,7 +1620,7 @@ and desugar_redefine_effect env d trans_qual quals eff_name eff_binders defn bui let env = if quals |> List.contains Reflectable then let reflect_lid = Ident.id_of_text "reflect" |> Env.qualify monad_env in - let refl_decl = S.Sig_declare_typ(reflect_lid, [], S.tun, [S.Assumption; S.Reflectable], d.drange) in + let refl_decl = S.Sig_declare_typ(reflect_lid, [], S.tun, [S.Assumption; S.Reflectable mname], d.drange) in push_sigelt env refl_decl else env in env, [se] @@ -1626,14 +1645,14 @@ and desugar_decl env (d:decl) : (env_t * sigelts) = | Tycon(qual, tcs) -> let tcs = List.map (fun (x,_) -> x) tcs in - desugar_tycon env d.drange (List.map trans_qual qual) tcs + desugar_tycon env d.drange (List.map (trans_qual None) qual) tcs | TopLevelLet(quals, isrec, lets) -> begin match (Subst.compress <| desugar_term_maybe_top true env (mk_term (Let(isrec, lets, mk_term (Const Const_unit) d.drange Expr)) d.drange Expr)).n with | Tm_let(lbs, _) -> let fvs = snd lbs |> List.map (fun lb -> right lb.lbname) in let quals = match quals with - | _::_ -> List.map trans_qual quals + | _::_ -> List.map (trans_qual None) quals | _ -> snd lbs |> List.collect (function | {lbname=Inl _} -> [] | {lbname=Inr fv} -> Env.lookup_letbinding_quals env fv.fv_name.v) in @@ -1664,7 +1683,7 @@ and desugar_decl env (d:decl) : (env_t * sigelts) = | Val(quals, id, t) -> let t = desugar_term env (close_fun env t) in let quals = if env.iface && env.admitted_iface then Assumption::quals else quals in - let se = Sig_declare_typ(qualify env id, [], t, List.map trans_qual quals, d.drange) in + let se = Sig_declare_typ(qualify env id, [], t, List.map (trans_qual None) quals, d.drange) in let env = push_sigelt env se in env, [se] diff --git a/src/syntax/print.fs b/src/syntax/print.fs index 85c7bde5de3..41b268faafc 100644 --- a/src/syntax/print.fs +++ b/src/syntax/print.fs @@ -206,7 +206,7 @@ let qual_to_string = function | HasMaskedEffect -> "HasMaskedEffect" | Effect -> "Effect" | Reifiable -> "reify" - | Reflectable -> "reflect" + | Reflectable l -> Util.format1 "(reflect %s)" l.str let quals_to_string quals = match quals with diff --git a/src/syntax/syntax.fs b/src/syntax/syntax.fs index 4b6e0e8cafe..d6632b6b0d6 100644 --- a/src/syntax/syntax.fs +++ b/src/syntax/syntax.fs @@ -214,7 +214,7 @@ type qualifier = | TotalEffect //an effect that forbis non-termination | Logic //a symbol whose intended usage is in the refinement logic | Reifiable - | Reflectable + | Reflectable of lident // with fully qualified effect name //the remaining qualifiers are internal: the programmer cannot write them | Discriminator of lident //discriminator for a datacon l | Projector of lident * ident //projector for datacon l's argument x @@ -239,6 +239,7 @@ type sub_eff = { type action = { action_name:lident; + action_unqualified_name: ident; // necessary for effect redefinitions, this name shall not contain the name of the effect action_univs:univ_names; action_defn:term; action_typ: typ; @@ -330,6 +331,9 @@ type mk_t = mk_t_a // VALS_HACK_HERE +let contains_reflectable (l: list): bool = + Util.for_some (function Reflectable _ -> true | _ -> false) l + (*********************************************************************************) (* Identifiers to/from strings *) (*********************************************************************************) diff --git a/src/syntax/syntax.fsi b/src/syntax/syntax.fsi index 73eaab38306..29ddb9fdd6a 100644 --- a/src/syntax/syntax.fsi +++ b/src/syntax/syntax.fsi @@ -216,7 +216,7 @@ type qualifier = | TotalEffect //an effect that forbids non-termination | Logic //a symbol whose intended usage is in the refinement logic | Reifiable - | Reflectable + | Reflectable of lident // with fully qualified effect name //the remaining qualifiers are internal: the programmer cannot write them | Discriminator of lident //discriminator for a datacon l | Projector of lident * ident //projector for datacon l's argument x @@ -247,6 +247,7 @@ type sub_eff = { *) type action = { action_name:lident; + action_unqualified_name: ident; // necessary for effect redefinitions, this name shall not contain the name of the effect action_univs:univ_names; action_defn:term; action_typ: typ; @@ -336,6 +337,8 @@ type subst_t = list type mk_t_a<'a,'b> = option<'b> -> range -> syntax<'a, 'b> type mk_t = mk_t_a +val contains_reflectable: list -> bool + val withsort: 'a -> 'b -> withinfo_t<'a,'b> val withinfo: 'a -> 'b -> Range.range -> withinfo_t<'a,'b> diff --git a/src/syntax/util.fs b/src/syntax/util.fs index d411aa574bb..80a96110ef3 100644 --- a/src/syntax/util.fs +++ b/src/syntax/util.fs @@ -30,8 +30,10 @@ open FStar.Const (**************************Utilities for identifiers ****************************) (********************************************************************************) +let qual_id lid id = set_lid_range (lid_of_ids (lid.ns @ [lid.ident;id])) id.idRange + let mk_discriminator lid = - lid_of_ids (lid.ns@[mk_ident("is_" ^ lid.ident.idText, lid.ident.idRange)]) + lid_of_ids (lid.ns@[mk_ident(Ident.reserved_prefix ^ "is_" ^ lid.ident.idText, lid.ident.idRange)]) let is_name (lid:lident) = let c = Util.char_at lid.ident.idText 0 in @@ -484,12 +486,59 @@ let unmangle_field_name x = then mk_ident(Util.substring_from x.idText 7, x.idRange) else x +(***********************************************************************************************) +(* Combining an effect name with the name of one of its actions, or a + data constructor name with the name of one of its formal parameters + + NOTE: the conventions defined here must be in sync with manually + linked ML files, such as ulib/ml/prims.ml + *) +(***********************************************************************************************) + +let field_projector_prefix = "__proj__" + +(* NOTE: the following would have been desirable: + +<< +let field_projector_prefix = Ident.reserved_prefix ^ "proj__" +>> + + but it DOES NOT work with --use_hints on + examples/preorders/MRefHeap.fst (even after regenerating hints), it + will produce the following error: + + fstar.exe --use_hints --verify_module MRefHeap MRefHeap.fst + ./MRefHeap.fst(55,51-58,27): (Error) Unknown assertion failed + Verified module: MRefHeap (2150 milliseconds) + 1 error was reported (see above) + + In fact, any naming convention that DOES NOT start with + Ident.reserved_prefix seems to work. +*) + +let field_projector_sep = "__item__" + +let field_projector_contains_constructor s = Util.starts_with s field_projector_prefix + +let mk_field_projector_name_from_string constr field = + field_projector_prefix ^ constr ^ field_projector_sep ^ field + +let mk_field_projector_name_from_ident lid (i : ident) = + let j = unmangle_field_name i in + let jtext = j.idText in + let newi = + if field_projector_contains_constructor jtext + then j + else mk_ident (mk_field_projector_name_from_string lid.ident.idText jtext, i.idRange) + in + lid_of_ids (lid.ns @ [newi]) + let mk_field_projector_name lid (x:bv) i = let nm = if Syntax.is_null_bv x then mk_ident("_" ^ Util.string_of_int i, Syntax.range_of_bv x) else x.ppname in let y = {x with ppname=nm} in - lid_of_ids (ids_of_lid lid @ [unmangle_field_name nm]), y + mk_field_projector_name_from_ident lid nm, y let set_uvar uv t = match Unionfind.find uv with diff --git a/src/typechecker/tcterm.fs b/src/typechecker/tcterm.fs index 86a205de962..7f9d4ba51b9 100644 --- a/src/typechecker/tcterm.fs +++ b/src/typechecker/tcterm.fs @@ -385,7 +385,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked begin match Env.effect_decl_opt env l with | None -> no_reflect() | Some ed -> - if not (ed.qualifiers |> List.contains Reflectable) then + if not (ed.qualifiers |> S.contains_reflectable) then no_reflect () else let env_no_ex, topt = Env.clear_expected_typ env in diff --git a/src/typechecker/util.fs b/src/typechecker/util.fs index 2a55e142470..084746f6b99 100644 --- a/src/typechecker/util.fs +++ b/src/typechecker/util.fs @@ -1238,7 +1238,7 @@ let check_sigelt_quals (env:FStar.TypeChecker.Env.env) se = | Inline_for_extraction -> true | _ -> false in let assumption = function Assumption | New -> true | _ -> false in - let reification = function Reifiable | Reflectable -> true | _ -> false in + let reification = function Reifiable | Reflectable _ -> true | _ -> false in let inferred = function | Discriminator _ | Projector _ @@ -1282,7 +1282,7 @@ let check_sigelt_quals (env:FStar.TypeChecker.Env.env) se = |> List.for_all (fun x -> x=q || x=Assumption || inferred x || visibility x || reducibility x) | Reifiable - | Reflectable -> + | Reflectable _ -> quals |> List.for_all (fun x -> reification x || inferred x || visibility x || x=TotalEffect) diff --git a/ucontrib/CoreCrypto/fst/CoreCrypto.fst b/ucontrib/CoreCrypto/fst/CoreCrypto.fst index b6fbbf63085..5af4c75aee1 100644 --- a/ucontrib/CoreCrypto/fst/CoreCrypto.fst +++ b/ucontrib/CoreCrypto/fst/CoreCrypto.fst @@ -146,19 +146,19 @@ assume val stream_fini : cipher_stream -> EXT unit assume val random : l:nat -> EXT (lbytes l) -assume val rsa_gen_key : int -> EXT (k:rsa_key{is_Some k.rsa_prv_exp}) +assume val rsa_gen_key : int -> EXT (k:rsa_key{Some? k.rsa_prv_exp}) assume val rsa_encrypt : rsa_key -> rsa_padding -> bytes -> EXT bytes -assume val rsa_decrypt : k:rsa_key{is_Some k.rsa_prv_exp} -> rsa_padding -> bytes -> EXT (option bytes) -assume val rsa_sign : option hash_alg -> k:rsa_key{is_Some k.rsa_prv_exp} -> bytes -> EXT bytes +assume val rsa_decrypt : k:rsa_key{Some? k.rsa_prv_exp} -> rsa_padding -> bytes -> EXT (option bytes) +assume val rsa_sign : option hash_alg -> k:rsa_key{Some? k.rsa_prv_exp} -> bytes -> EXT bytes assume val rsa_verify : option hash_alg -> rsa_key -> bytes -> bytes -> EXT bool -assume val dsa_gen_key : int -> EXT (k:dsa_key{is_Some k.dsa_private}) -assume val dsa_sign : option hash_alg -> k:dsa_key{is_Some k.dsa_private} -> bytes -> EXT bytes +assume val dsa_gen_key : int -> EXT (k:dsa_key{Some? k.dsa_private}) +assume val dsa_sign : option hash_alg -> k:dsa_key{Some? k.dsa_private} -> bytes -> EXT bytes assume val dsa_verify : option hash_alg -> dsa_key -> bytes -> bytes -> Tot bool assume val dh_gen_params : int -> EXT dh_params -assume val dh_gen_key : p:dh_params -> EXT (k:dh_key{is_Some k.dh_private /\ k.dh_params = p /\ length k.dh_public <= length p.dh_p}) -assume val dh_agreement : k:dh_key{is_Some k.dh_private} -> bytes -> EXT bytes +assume val dh_gen_key : p:dh_params -> EXT (k:dh_key{Some? k.dh_private /\ k.dh_params = p /\ length k.dh_public <= length p.dh_p}) +assume val dh_agreement : k:dh_key{Some? k.dh_private} -> bytes -> EXT bytes (* type ec_prime = { ecp_prime : string; ecp_order : string; ecp_a : string; ecp_b : string; ecp_gx : string; ecp_gy : string; ecp_bytelen : int; ecp_id : bytes; } *) @@ -191,12 +191,12 @@ type ec_key = { } assume val ec_is_on_curve: ec_params -> ec_point -> Tot bool -assume val ecdh_agreement: k:ec_key{is_Some k.ec_priv} -> ec_point -> EXT bytes +assume val ecdh_agreement: k:ec_key{Some? k.ec_priv} -> ec_point -> EXT bytes -assume val ecdsa_sign: option hash_alg -> k:ec_key{is_Some k.ec_priv} -> bytes -> EXT bytes +assume val ecdsa_sign: option hash_alg -> k:ec_key{Some? k.ec_priv} -> bytes -> EXT bytes assume val ecdsa_verify: option hash_alg -> ec_key -> bytes -> bytes -> EXT bool assume val ec_gen_key: p:ec_params - -> EXT (k:ec_key{is_Some k.ec_priv /\ k.ec_params = p /\ + -> EXT (k:ec_key{Some? k.ec_priv /\ k.ec_params = p /\ length k.ec_point.ecx = ec_bytelen k.ec_params.curve /\ length k.ec_point.ecy = ec_bytelen k.ec_params.curve}) @@ -210,9 +210,9 @@ type key = // with keys that are missing the "private" field. // The only has_priv keys are the ones loaded with load_key and or generated with gen_key let has_priv : key -> Type0 = function - | KeyRSA k -> is_Some k.rsa_prv_exp - | KeyDSA k -> is_Some k.dsa_private - | KeyECDSA k -> is_Some k.ec_priv + | KeyRSA k -> Some? k.rsa_prv_exp + | KeyDSA k -> Some? k.dsa_private + | KeyECDSA k -> Some? k.ec_priv assume val validate_chain: der_list:list bytes -> for_signing:bool -> hostname:option string -> ca_file:string -> Tot bool assume val get_key_from_cert: bytes -> Tot (option key) diff --git a/ucontrib/Platform/fst/Platform.Error.fst b/ucontrib/Platform/fst/Platform.Error.fst index 2629712e01e..3fb269619bb 100644 --- a/ucontrib/Platform/fst/Platform.Error.fst +++ b/ucontrib/Platform/fst/Platform.Error.fst @@ -10,7 +10,7 @@ type optResult 'a 'b = //allowing inverting optResult without having to globally increase the fuel just for this val invertOptResult : a:Type -> b:Type -> Lemma (requires True) - (ensures (forall (x:optResult a b). is_Error x \/ is_Correct x)) + (ensures (forall (x:optResult a b). Error? x \/ Correct? x)) [SMTPatT (optResult a b)] let invertOptResult a b = allow_inversion (optResult a b) diff --git a/ucontrib/Platform/ml/platform.ml b/ucontrib/Platform/ml/platform.ml index 077edabbd0d..715a05c468f 100644 --- a/ucontrib/Platform/ml/platform.ml +++ b/ucontrib/Platform/ml/platform.ml @@ -6,11 +6,11 @@ module Error = struct let perror (file:string) (line:Z.t) (text:string) = text - let is_Correct = function + let uu___is_Correct = function | Correct _ -> true | _ -> false - let is_Error = function + let uu___is_Error = function | Error _ -> true | _ -> false diff --git a/ulib/FStar.All.fst b/ulib/FStar.All.fst index ac3159c1001..4ad5f9da664 100644 --- a/ulib/FStar.All.fst +++ b/ulib/FStar.All.fst @@ -36,6 +36,6 @@ effect ML (a:Type) = assume val pipe_right: 'a -> ('a -> 'b) -> 'b assume val pipe_left: ('a -> 'b) -> 'a -> 'b -assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> is_Err a /\ h==h') +assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h') assume val exit: int -> 'a assume val try_with: (unit -> 'a) -> (exn -> 'a) -> 'a diff --git a/ulib/FStar.Axiomatic.Array.fst b/ulib/FStar.Axiomatic.Array.fst index 609c0423371..353454678dc 100644 --- a/ulib/FStar.Axiomatic.Array.fst +++ b/ulib/FStar.Axiomatic.Array.fst @@ -90,5 +90,5 @@ assume EmpConst: forall (a:Type) (s:seq a).{:pattern (length s)} length s == 0 ==> s==emp a -type is_Some_All (a:Type) (s:seq (option a)) = (forall (i:int). (0 <= i /\ i < length s) ==> is_Some (index s i)) +type is_Some_All (a:Type) (s:seq (option a)) = (forall (i:int). (0 <= i /\ i < length s) ==> Some? (index s i)) diff --git a/ulib/FStar.HyperHeap.fst b/ulib/FStar.HyperHeap.fst index bea1b66625b..3d99fb8456a 100644 --- a/ulib/FStar.HyperHeap.fst +++ b/ulib/FStar.HyperHeap.fst @@ -70,7 +70,7 @@ abstract val includes : rid -> rid -> GTot bool let rec includes r1 r2 = if r1=r2 then true else if List.Tot.length r2 > List.Tot.length r1 - then includes r1 (Cons.tl r2) + then includes r1 (Cons?.tl r2) else false let disjoint (i:rid) (j:rid) : GTot bool = @@ -81,10 +81,10 @@ private val lemma_aux: k:rid -> i:rid List.Tot.length k > 0 /\ List.Tot.length k <= List.Tot.length i /\ includes k i - /\ not (includes (Cons.tl k) i)) + /\ not (includes (Cons?.tl k) i)) (ensures False) (decreases (List.Tot.length i)) -let rec lemma_aux k i = lemma_aux k (Cons.tl i) +let rec lemma_aux k i = lemma_aux k (Cons?.tl i) abstract val lemma_disjoint_includes: i:rid -> j:rid -> k:rid -> Lemma (requires (disjoint i j /\ includes j k)) @@ -95,18 +95,18 @@ abstract val lemma_disjoint_includes: i:rid -> j:rid -> k:rid -> let rec lemma_disjoint_includes i j k = if List.Tot.length k <= List.Tot.length j then () - else (lemma_disjoint_includes i j (Cons.tl k); - if List.Tot.length i <= List.Tot.length (Cons.tl k) + else (lemma_disjoint_includes i j (Cons?.tl k); + if List.Tot.length i <= List.Tot.length (Cons?.tl k) then () else (if includes k i then lemma_aux k i else ())) abstract val extends: rid -> rid -> GTot bool -let extends r0 r1 = is_Cons r0 && Cons.tl r0 = r1 +let extends r0 r1 = Cons? r0 && Cons?.tl r0 = r1 abstract val parent: r:rid{r<>root} -> Tot rid -let parent r = Cons.tl r +let parent r = Cons?.tl r abstract val lemma_includes_refl: i:rid -> Lemma (requires (True)) diff --git a/ulib/FStar.Integers.fst b/ulib/FStar.Integers.fst index 8610aefafbb..8b74bd44837 100644 --- a/ulib/FStar.Integers.fst +++ b/ulib/FStar.Integers.fst @@ -65,64 +65,64 @@ unfold let op_Plus (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n{ok s n (v x + : Tot (z:int_t s n{v z = v x + v y}) = match s, n with | _, 0 -> x + y - | Unsigned, 8 -> FStar.UInt8(x +^ y) - | Unsigned, 16 -> FStar.UInt16(x +^ y) - | Unsigned, 31 -> FStar.UInt31(x +^ y) - | Unsigned, 32 -> FStar.UInt32(x +^ y) - | Unsigned, 63 -> FStar.UInt63(x +^ y) - | Unsigned, 64 -> FStar.UInt64(x +^ y) - | Unsigned, 128 -> FStar.UInt128(x +^ y) - | Signed, 8 -> FStar.Int8(x +^ y) - | Signed, 16 -> FStar.Int16(x +^ y) - | Signed, 31 -> FStar.Int31(x +^ y) - | Signed, 32 -> FStar.Int32(x +^ y) - | Signed, 63 -> FStar.Int63(x +^ y) - | Signed, 64 -> FStar.Int64(x +^ y) - | Signed, 128 -> FStar.Int128(x +^ y) + | Unsigned, 8 -> FStar.UInt8.(x +^ y) + | Unsigned, 16 -> FStar.UInt16.(x +^ y) + | Unsigned, 31 -> FStar.UInt31.(x +^ y) + | Unsigned, 32 -> FStar.UInt32.(x +^ y) + | Unsigned, 63 -> FStar.UInt63.(x +^ y) + | Unsigned, 64 -> FStar.UInt64.(x +^ y) + | Unsigned, 128 -> FStar.UInt128.(x +^ y) + | Signed, 8 -> FStar.Int8.(x +^ y) + | Signed, 16 -> FStar.Int16.(x +^ y) + | Signed, 31 -> FStar.Int31.(x +^ y) + | Signed, 32 -> FStar.Int32.(x +^ y) + | Signed, 63 -> FStar.Int63.(x +^ y) + | Signed, 64 -> FStar.Int64.(x +^ y) + | Signed, 128 -> FStar.Int128.(x +^ y) unfold let op_Plus_Question (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{ok s n (v x + v y) ==> v z = v x + v y}) = match s, n with | _, 0 -> x + y - | Unsigned, 8 -> FStar.UInt8(x +?^ y) - | Unsigned, 16 -> FStar.UInt16(x +?^ y) - | Unsigned, 31 -> FStar.UInt31(x +?^ y) - | Unsigned, 32 -> FStar.UInt32(x +?^ y) - | Unsigned, 63 -> FStar.UInt63(x +?^ y) - | Unsigned, 64 -> FStar.UInt64(x +?^ y) - | Unsigned, 128 -> FStar.UInt128(x +?^ y) - | Signed, 8 -> FStar.Int8(x +?^ y) - | Signed, 16 -> FStar.Int16(x +?^ y) - | Signed, 31 -> FStar.Int31(x +?^ y) - | Signed, 32 -> FStar.Int32(x +?^ y) - | Signed, 63 -> FStar.Int63(x +?^ y) - | Signed, 64 -> FStar.Int64(x +?^ y) - | Signed, 128 -> FStar.Int128(x +?^ y) + | Unsigned, 8 -> FStar.UInt8.(x +?^ y) + | Unsigned, 16 -> FStar.UInt16.(x +?^ y) + | Unsigned, 31 -> FStar.UInt31.(x +?^ y) + | Unsigned, 32 -> FStar.UInt32.(x +?^ y) + | Unsigned, 63 -> FStar.UInt63.(x +?^ y) + | Unsigned, 64 -> FStar.UInt64.(x +?^ y) + | Unsigned, 128 -> FStar.UInt128.(x +?^ y) + | Signed, 8 -> FStar.Int8.(x +?^ y) + | Signed, 16 -> FStar.Int16.(x +?^ y) + | Signed, 31 -> FStar.Int31.(x +?^ y) + | Signed, 32 -> FStar.Int32.(x +?^ y) + | Signed, 63 -> FStar.Int63.(x +?^ y) + | Signed, 64 -> FStar.Int64.(x +?^ y) + | Signed, 128 -> FStar.Int128.(x +?^ y) let modulo (s:signed) (x:int) (y:pos{s=Signed ==> y%2=0}) = match s with | Unsigned -> x % y - | _ -> FStar.Int (x @% y) + | _ -> FStar.Int.(x @% y) #reset-options "--z3rlimit 5 --initial_fuel 1 --max_fuel 1" unfold let op_Plus_Percent (#s:signed) (#n:pos) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{v z = modulo s (v x + v y) (pow2 n)}) = match s, n with - | Unsigned, 8 -> FStar.UInt8(x +%^ y) - | Unsigned, 16 -> FStar.UInt16(x +%^ y) - | Unsigned, 31 -> FStar.UInt31(x +%^ y) - | Unsigned, 32 -> FStar.UInt32(x +%^ y) - | Unsigned, 63 -> FStar.UInt63(x +%^ y) - | Unsigned, 64 -> FStar.UInt64(x +%^ y) - | Unsigned, 128 -> FStar.UInt128(x +%^ y) - | Signed, 8 -> FStar.Int8(x +%^ y) - | Signed, 16 -> FStar.Int16(x +%^ y) - | Signed, 31 -> FStar.Int31(x +%^ y) - | Signed, 32 -> FStar.Int32(x +%^ y) - | Signed, 63 -> FStar.Int63(x +%^ y) - | Signed, 64 -> FStar.Int64(x +%^ y) - | Signed, 128 -> FStar.Int128(x +%^ y) + | Unsigned, 8 -> FStar.UInt8.(x +%^ y) + | Unsigned, 16 -> FStar.UInt16.(x +%^ y) + | Unsigned, 31 -> FStar.UInt31.(x +%^ y) + | Unsigned, 32 -> FStar.UInt32.(x +%^ y) + | Unsigned, 63 -> FStar.UInt63.(x +%^ y) + | Unsigned, 64 -> FStar.UInt64.(x +%^ y) + | Unsigned, 128 -> FStar.UInt128.(x +%^ y) + | Signed, 8 -> FStar.Int8.(x +%^ y) + | Signed, 16 -> FStar.Int16.(x +%^ y) + | Signed, 31 -> FStar.Int31.(x +%^ y) + | Signed, 32 -> FStar.Int32.(x +%^ y) + | Signed, 63 -> FStar.Int63.(x +%^ y) + | Signed, 64 -> FStar.Int64.(x +%^ y) + | Signed, 128 -> FStar.Int128.(x +%^ y) #reset-options "--z3rlimit 5" @@ -130,60 +130,60 @@ unfold let op_Subtraction (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n{ok s n : Tot (z:int_t s n{v z = v x - v y}) = match s, n with | _, 0 -> x - y - | Unsigned, 8 -> FStar.UInt8(x -^ y) - | Unsigned, 16 -> FStar.UInt16(x -^ y) - | Unsigned, 31 -> FStar.UInt31(x -^ y) - | Unsigned, 32 -> FStar.UInt32(x -^ y) - | Unsigned, 63 -> FStar.UInt63(x -^ y) - | Unsigned, 64 -> FStar.UInt64(x -^ y) - | Unsigned, 128 -> FStar.UInt128(x -^ y) - | Signed, 8 -> FStar.Int8(x -^ y) - | Signed, 16 -> FStar.Int16(x -^ y) - | Signed, 31 -> FStar.Int31(x -^ y) - | Signed, 32 -> FStar.Int32(x -^ y) - | Signed, 63 -> FStar.Int63(x -^ y) - | Signed, 64 -> FStar.Int64(x -^ y) - | Signed, 128 -> FStar.Int128(x -^ y) + | Unsigned, 8 -> FStar.UInt8.(x -^ y) + | Unsigned, 16 -> FStar.UInt16.(x -^ y) + | Unsigned, 31 -> FStar.UInt31.(x -^ y) + | Unsigned, 32 -> FStar.UInt32.(x -^ y) + | Unsigned, 63 -> FStar.UInt63.(x -^ y) + | Unsigned, 64 -> FStar.UInt64.(x -^ y) + | Unsigned, 128 -> FStar.UInt128.(x -^ y) + | Signed, 8 -> FStar.Int8.(x -^ y) + | Signed, 16 -> FStar.Int16.(x -^ y) + | Signed, 31 -> FStar.Int31.(x -^ y) + | Signed, 32 -> FStar.Int32.(x -^ y) + | Signed, 63 -> FStar.Int63.(x -^ y) + | Signed, 64 -> FStar.Int64.(x -^ y) + | Signed, 128 -> FStar.Int128.(x -^ y) unfold let op_Subtraction_Question (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{ok s n (v x - v y) ==> v z = v x - v y}) = match s, n with | Unsigned, 0 -> if v x - v y >= 0 then x - y else 0 - | Unsigned, 8 -> FStar.UInt8(x -?^ y) - | Unsigned, 16 -> FStar.UInt16(x -?^ y) - | Unsigned, 31 -> FStar.UInt31(x -?^ y) - | Unsigned, 32 -> FStar.UInt32(x -?^ y) - | Unsigned, 63 -> FStar.UInt63(x -?^ y) - | Unsigned, 64 -> FStar.UInt64(x -?^ y) - | Unsigned, 128 -> FStar.UInt128(x -?^ y) + | Unsigned, 8 -> FStar.UInt8.(x -?^ y) + | Unsigned, 16 -> FStar.UInt16.(x -?^ y) + | Unsigned, 31 -> FStar.UInt31.(x -?^ y) + | Unsigned, 32 -> FStar.UInt32.(x -?^ y) + | Unsigned, 63 -> FStar.UInt63.(x -?^ y) + | Unsigned, 64 -> FStar.UInt64.(x -?^ y) + | Unsigned, 128 -> FStar.UInt128.(x -?^ y) | Signed, 0 -> x - y - | Signed, 8 -> FStar.Int8(x -?^ y) - | Signed, 16 -> FStar.Int16(x -?^ y) - | Signed, 31 -> FStar.Int31(x -?^ y) - | Signed, 32 -> FStar.Int32(x -?^ y) - | Signed, 63 -> FStar.Int63(x -?^ y) - | Signed, 64 -> FStar.Int64(x -?^ y) - | Signed, 128 -> FStar.Int128(x -?^ y) + | Signed, 8 -> FStar.Int8.(x -?^ y) + | Signed, 16 -> FStar.Int16.(x -?^ y) + | Signed, 31 -> FStar.Int31.(x -?^ y) + | Signed, 32 -> FStar.Int32.(x -?^ y) + | Signed, 63 -> FStar.Int63.(x -?^ y) + | Signed, 64 -> FStar.Int64.(x -?^ y) + | Signed, 128 -> FStar.Int128.(x -?^ y) #reset-options "--z3rlimit 20" unfold let op_Subtraction_Percent (#s:signed) (#n:pos) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{v z = modulo s (v x - v y) (pow2 n)}) = match s, n with - | Unsigned, 8 -> FStar.UInt8(x -%^ y) - | Unsigned, 16 -> FStar.UInt16(x -%^ y) - | Unsigned, 31 -> FStar.UInt31(x -%^ y) - | Unsigned, 32 -> FStar.UInt32(x -%^ y) - | Unsigned, 63 -> FStar.UInt63(x -%^ y) - | Unsigned, 64 -> FStar.UInt64(x -%^ y) - | Unsigned, 128 -> FStar.UInt128(x -%^ y) - | Signed, 8 -> FStar.Int8(x -%^ y) - | Signed, 16 -> FStar.Int16(x -%^ y) - | Signed, 31 -> FStar.Int31(x -%^ y) - | Signed, 32 -> FStar.Int32(x -%^ y) - | Signed, 63 -> FStar.Int63(x -%^ y) - | Signed, 64 -> FStar.Int64(x -%^ y) - | Signed, 128 -> FStar.Int128(x -%^ y) + | Unsigned, 8 -> FStar.UInt8.(x -%^ y) + | Unsigned, 16 -> FStar.UInt16.(x -%^ y) + | Unsigned, 31 -> FStar.UInt31.(x -%^ y) + | Unsigned, 32 -> FStar.UInt32.(x -%^ y) + | Unsigned, 63 -> FStar.UInt63.(x -%^ y) + | Unsigned, 64 -> FStar.UInt64.(x -%^ y) + | Unsigned, 128 -> FStar.UInt128.(x -%^ y) + | Signed, 8 -> FStar.Int8.(x -%^ y) + | Signed, 16 -> FStar.Int16.(x -%^ y) + | Signed, 31 -> FStar.Int31.(x -%^ y) + | Signed, 32 -> FStar.Int32.(x -%^ y) + | Signed, 63 -> FStar.Int63.(x -%^ y) + | Signed, 64 -> FStar.Int64.(x -%^ y) + | Signed, 128 -> FStar.Int128.(x -%^ y) #reset-options "--z3rlimit 5" @@ -193,20 +193,20 @@ unfold let op_Star (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n{ok s n (v x * : Tot (z:int_t s n{v z = v x * v y}) = match s, n with | _, 0 -> x * y - | Unsigned, 8 -> FStar.UInt8(x *^ y) - | Unsigned, 16 -> FStar.UInt16(x *^ y) - | Unsigned, 31 -> FStar.UInt31(x *^ y) - | Unsigned, 32 -> FStar.UInt32(x *^ y) - | Unsigned, 63 -> FStar.UInt63(x *^ y) - | Unsigned, 64 -> FStar.UInt64(x *^ y) - | Unsigned, 128 -> FStar.UInt128(x *^ y) - | Signed, 8 -> FStar.Int8(x *^ y) - | Signed, 16 -> FStar.Int16(x *^ y) - | Signed, 31 -> FStar.Int31(x *^ y) - | Signed, 32 -> FStar.Int32(x *^ y) - | Signed, 63 -> FStar.Int63(x *^ y) - | Signed, 64 -> FStar.Int64(x *^ y) - | Signed, 128 -> FStar.Int128(x *^ y) + | Unsigned, 8 -> FStar.UInt8.(x *^ y) + | Unsigned, 16 -> FStar.UInt16.(x *^ y) + | Unsigned, 31 -> FStar.UInt31.(x *^ y) + | Unsigned, 32 -> FStar.UInt32.(x *^ y) + | Unsigned, 63 -> FStar.UInt63.(x *^ y) + | Unsigned, 64 -> FStar.UInt64.(x *^ y) + | Unsigned, 128 -> FStar.UInt128.(x *^ y) + | Signed, 8 -> FStar.Int8.(x *^ y) + | Signed, 16 -> FStar.Int16.(x *^ y) + | Signed, 31 -> FStar.Int31.(x *^ y) + | Signed, 32 -> FStar.Int32.(x *^ y) + | Signed, 63 -> FStar.Int63.(x *^ y) + | Signed, 64 -> FStar.Int64.(x *^ y) + | Signed, 128 -> FStar.Int128.(x *^ y) #reset-options "--z3rlimit 20" @@ -214,40 +214,40 @@ unfold let op_Star_Question (#s:signed) (#n:nat) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{ok s n (v x * v y) ==> v z = v x * v y}) = match s, n with | _, 0 -> x * y - | Unsigned, 8 -> FStar.UInt8(x *?^ y) - | Unsigned, 16 -> FStar.UInt16(x *?^ y) - | Unsigned, 31 -> FStar.UInt31(x *?^ y) - | Unsigned, 32 -> FStar.UInt32(x *?^ y) - | Unsigned, 63 -> FStar.UInt63(x *?^ y) - | Unsigned, 64 -> FStar.UInt64(x *?^ y) - | Unsigned, 128 -> FStar.UInt128(x *?^ y) - | Signed, 8 -> FStar.Int8(x *?^ y) - | Signed, 16 -> FStar.Int16(x *?^ y) - | Signed, 31 -> FStar.Int31(x *?^ y) - | Signed, 32 -> FStar.Int32(x *?^ y) - | Signed, 63 -> FStar.Int63(x *?^ y) - | Signed, 64 -> FStar.Int64(x *?^ y) - | Signed, 128 -> FStar.Int128(x *?^ y) + | Unsigned, 8 -> FStar.UInt8.(x *?^ y) + | Unsigned, 16 -> FStar.UInt16.(x *?^ y) + | Unsigned, 31 -> FStar.UInt31.(x *?^ y) + | Unsigned, 32 -> FStar.UInt32.(x *?^ y) + | Unsigned, 63 -> FStar.UInt63.(x *?^ y) + | Unsigned, 64 -> FStar.UInt64.(x *?^ y) + | Unsigned, 128 -> FStar.UInt128.(x *?^ y) + | Signed, 8 -> FStar.Int8.(x *?^ y) + | Signed, 16 -> FStar.Int16.(x *?^ y) + | Signed, 31 -> FStar.Int31.(x *?^ y) + | Signed, 32 -> FStar.Int32.(x *?^ y) + | Signed, 63 -> FStar.Int63.(x *?^ y) + | Signed, 64 -> FStar.Int64.(x *?^ y) + | Signed, 128 -> FStar.Int128.(x *?^ y) #reset-options "--z3rlimit 5" unfold let op_Star_Percent (#s:signed) (#n:pos) (x:int_t s n) (y:int_t s n) : Tot (z:int_t s n{v z = modulo s (v x * v y) (pow2 n)}) = match s, n with - | Unsigned, 8 -> FStar.UInt8(x *%^ y) - | Unsigned, 16 -> FStar.UInt16(x *%^ y) - | Unsigned, 31 -> FStar.UInt31(x *%^ y) - | Unsigned, 32 -> FStar.UInt32(x *%^ y) - | Unsigned, 63 -> FStar.UInt63(x *%^ y) - | Unsigned, 64 -> FStar.UInt64(x *%^ y) - | Unsigned, 128 -> FStar.UInt128(x *%^ y) - | Signed, 8 -> FStar.Int8(x *%^ y) - | Signed, 16 -> FStar.Int16(x *%^ y) - | Signed, 31 -> FStar.Int31(x *%^ y) - | Signed, 32 -> FStar.Int32(x *%^ y) - | Signed, 63 -> FStar.Int63(x *%^ y) - | Signed, 64 -> FStar.Int64(x *%^ y) - | Signed, 128 -> FStar.Int128(x *%^ y) + | Unsigned, 8 -> FStar.UInt8.(x *%^ y) + | Unsigned, 16 -> FStar.UInt16.(x *%^ y) + | Unsigned, 31 -> FStar.UInt31.(x *%^ y) + | Unsigned, 32 -> FStar.UInt32.(x *%^ y) + | Unsigned, 63 -> FStar.UInt63.(x *%^ y) + | Unsigned, 64 -> FStar.UInt64.(x *%^ y) + | Unsigned, 128 -> FStar.UInt128.(x *%^ y) + | Signed, 8 -> FStar.Int8.(x *%^ y) + | Signed, 16 -> FStar.Int16.(x *%^ y) + | Signed, 31 -> FStar.Int31.(x *%^ y) + | Signed, 32 -> FStar.Int32.(x *%^ y) + | Signed, 63 -> FStar.Int63.(x *%^ y) + | Signed, 64 -> FStar.Int64.(x *%^ y) + | Signed, 128 -> FStar.Int128.(x *%^ y) unfold let nat = int_t Unsigned 0 diff --git a/ulib/FStar.List.Tot.fst b/ulib/FStar.List.Tot.fst index 787c92e7301..2be9dbdaf2f 100644 --- a/ulib/FStar.List.Tot.fst +++ b/ulib/FStar.List.Tot.fst @@ -22,11 +22,11 @@ let isEmpty l = match l with | [] -> true | _ -> false -val hd: l:list 'a{is_Cons l} -> Tot 'a +val hd: l:list 'a{Cons? l} -> Tot 'a let hd = function | hd::_ -> hd -val tl: l:list 'a {is_Cons l} -> Tot (list 'a) +val tl: l:list 'a {Cons? l} -> Tot (list 'a) let tl = function | _::tl -> tl diff --git a/ulib/FStar.Math.Lemmas.fst b/ulib/FStar.Math.Lemmas.fst index 2c80d9b1d60..23ea2a8f9be 100644 --- a/ulib/FStar.Math.Lemmas.fst +++ b/ulib/FStar.Math.Lemmas.fst @@ -303,7 +303,7 @@ let lemma_mod_plus_distr_l a b p = lemma_mod_spec2 a p; lemma_mod_plus (a % p + b) q p -#reset-options "--initial_fuel 0 --max_fuel 0" +#reset-options "--z3rlimit 1000 --initial_fuel 0 --max_fuel 0" val lemma_mod_plus_mul_distr: a:nat -> b:nat -> c:nat -> p:pos -> Lemma (((a + b) * c) % p = ((((a % p) + (b % p)) % p) * (c % p)) % p) @@ -313,6 +313,8 @@ let lemma_mod_plus_mul_distr a b c p = lemma_mod_plus_distr_l a b p; lemma_mod_plus_distr_l b (a % p) p +#reset-options "--initial_fuel 0 --max_fuel 0" + val lemma_mod_mod: a:int -> b:int -> p:pos -> Lemma (requires (a = b % p)) (ensures (a % p = b % p)) @@ -538,7 +540,7 @@ let pow2_multiplication_modulo_lemma_1 a b c = paren_mul_left a (pow2 (c - b)) (pow2 b); multiple_modulo_lemma (a * pow2 (c - b)) (pow2 b) -#reset-options "--z3rlimit 500 --initial_fuel 0 --max_fuel 0" +#reset-options "--z3rlimit 1000 --initial_fuel 0 --max_fuel 0" val pow2_multiplication_modulo_lemma_2: a:nat -> b:nat -> c:nat{c <= b} -> Lemma ( (a * pow2 c) % pow2 b = (a % pow2 (b - c)) * pow2 c ) diff --git a/ulib/FStar.Math.Lemmas.fst.hints b/ulib/FStar.Math.Lemmas.fst.hints index c05ecf77cd1..6dbf9a33936 100644 --- a/ulib/FStar.Math.Lemmas.fst.hints +++ b/ulib/FStar.Math.Lemmas.fst.hints @@ -1,5 +1,5 @@ [ - "O[]X\u001a{OtM|", + "ė]\fӡ", [ [ "FStar.Math.Lemmas.euclidean_div_axiom", @@ -135,9 +135,8 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", - "unit_typing" + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", "unit_typing" ], 0 ], @@ -156,9 +155,8 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "int_inversion", - "int_typing", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "unit_typing" + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", "unit_typing" ], 0 ], @@ -177,9 +175,8 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "int_inversion", - "int_typing", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "unit_typing" + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", "unit_typing" ], 0 ], @@ -191,7 +188,14 @@ [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "FStar.Math.Lemmas.paren_mul_left", 2, 0, 1, [ "@query" ], 0 ], + [ + "FStar.Math.Lemmas.paren_mul_left", + 2, + 0, + 1, + [ "@query", "unit_typing" ], + 0 + ], [ "FStar.Math.Lemmas.paren_mul_right", 1, @@ -220,7 +224,14 @@ [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "FStar.Math.Lemmas.paren_add_left", 2, 0, 1, [ "@query" ], 0 ], + [ + "FStar.Math.Lemmas.paren_add_left", + 2, + 0, + 1, + [ "@query", "unit_typing" ], + 0 + ], [ "FStar.Math.Lemmas.paren_add_right", 1, @@ -374,9 +385,8 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "int_inversion", - "int_typing", "primitive_Prims.op_Minus", - "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", - "unit_typing" + "primitive_Prims.op_Minus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", "unit_typing" ], 0 ], @@ -417,7 +427,14 @@ [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "FStar.Math.Lemmas.mul_binds_tighter", 2, 0, 1, [ "@query" ], 0 ], + [ + "FStar.Math.Lemmas.mul_binds_tighter", + 2, + 0, + 1, + [ "@query", "unit_typing" ], + 0 + ], [ "FStar.Math.Lemmas.mul_ineq1", 1, @@ -569,7 +586,8 @@ "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "typing_Prims.pow2", "unit_typing", "well-founded-ordering-on-nat" + "typing_Prims.pow2", "unit_inversion", "unit_typing", + "well-founded-ordering-on-nat" ], 0 ], @@ -656,7 +674,8 @@ 1, 1, [ - "@query", "equation_Prims.nat", "equation_Prims.pos", + "@query", "bool_inversion", "equation_Prims.nat", + "equation_Prims.pos", "equation_with_fuel_Prims.pow2.fuel_instrumented", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", "int_typing", "pretyping_ae567c2fb75be05905677af440075565", @@ -669,7 +688,7 @@ "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "token_correspondence_Prims.pow2.fuel_instrumented", - "typing_Prims.pow2", "unit_typing" + "typing_Prims.pow2", "unit_inversion", "unit_typing" ], 0 ], @@ -692,7 +711,7 @@ 1, [ "@query", "primitive_Prims.op_Subtraction", - "projection_inverse_BoxInt_proj_0", "unit_inversion", "unit_typing" + "projection_inverse_BoxInt_proj_0" ], 0 ], @@ -711,9 +730,11 @@ 0, 1, [ - "@query", "equation_Prims.nat", "int_inversion", - "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "@query", "equation_Prims.nat", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "unit_typing" ], 0 @@ -810,12 +831,19 @@ [ "@query", "assumption_Prims.HasEq_int" ], 0 ], - [ "FStar.Math.Lemmas.lemma_eq_trans_2", 5, 0, 1, [ "@query" ], 0 ], + [ + "FStar.Math.Lemmas.lemma_eq_trans_2", + 5, + 0, + 1, + [ "@query", "unit_typing" ], + 0 + ], [ "FStar.Math.Lemmas.lemma_mod_plus_0", 1, 0, - 1, + 2, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", "equation_Prims.pos", "int_inversion", "int_typing", @@ -974,9 +1002,10 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "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", + "equation_Prims.pos", "int_inversion", "int_typing", + "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_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], @@ -1018,11 +1047,9 @@ 0, 1, [ - "@query", "equation_Prims.nat", "equation_Prims.pos", - "int_inversion", "primitive_Prims.op_Modulus", - "projection_inverse_BoxInt_proj_0", + "@query", "equation_Prims.nat", "int_inversion", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "unit_typing" ], 0 @@ -1189,15 +1216,14 @@ "FStar.Math.Lemmas.lemma_mod_spec2", 3, 0, - 1, + 2, [ "@query", "equation_FStar.Mul.op_Star", "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_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "unit_inversion", "unit_typing" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 ], @@ -1213,8 +1239,7 @@ "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "unit_inversion", "unit_typing" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 ], @@ -1287,9 +1312,7 @@ 2, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", "function_token_typing_FStar.Mul.op_Star", - "int_inversion", "int_typing", - "interpretation_Tm_arrow_44faff5d8543c30ad9bf2eeaf1b3abcf", + "equation_Prims.pos", "int_inversion", "int_typing", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Addition", "primitive_Prims.op_Division", "primitive_Prims.op_Equality", "primitive_Prims.op_Modulus", @@ -1297,7 +1320,7 @@ "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "token_correspondence_FStar.Mul.op_Star", "unit_inversion" + "unit_inversion" ], 0 ], @@ -1376,7 +1399,7 @@ "FStar.Math.Lemmas.lemma_mod_plus_mul_distr", 3, 0, - 2, + 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", @@ -1420,7 +1443,7 @@ 0, 1, [ - "@query", "equation_Prims.pos", "projection_inverse_BoxInt_proj_0", + "@query", "equation_Prims.pos", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 @@ -1451,10 +1474,9 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "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", - "projection_inverse_BoxInt_proj_0", + "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_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "unit_typing" @@ -1503,9 +1525,11 @@ 0, 1, [ - "@query", "equation_Prims.nat", "int_inversion", - "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "@query", "equation_Prims.nat", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "unit_typing" ], 0 @@ -1547,9 +1571,10 @@ 0, 1, [ - "@query", "equation_Prims.nat", "primitive_Prims.op_Division", - "projection_inverse_BoxInt_proj_0", + "@query", "equation_Prims.nat", "equation_Prims.pos", + "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "unit_typing" ], 0 @@ -1643,7 +1668,7 @@ "refinement_interpretation_Tm_refine_a687c5b77765d0fae789507d00b72673", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "unit_typing" + "unit_inversion", "unit_typing" ], 0 ], @@ -1756,8 +1781,7 @@ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.pos", "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", - "unit_inversion", "unit_typing" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" ], 0 ], @@ -1882,7 +1906,7 @@ [ "FStar.Math.Lemmas.modulo_distributivity", 1, - 0, + 1, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -1890,7 +1914,7 @@ [ "FStar.Math.Lemmas.modulo_distributivity", 2, - 0, + 1, 1, [ "@query", "equation_Prims.pos", @@ -1992,13 +2016,14 @@ "FStar.Math.Lemmas.division_multiplication_lemma", 3, 0, - 2, + 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", - "primitive_Prims.op_Division", "primitive_Prims.op_LessThan", - "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", - "primitive_Prims.op_Subtraction", + "equation_Prims.pos", "int_inversion", + "pretyping_ae567c2fb75be05905677af440075565", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThan", "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_ba523126f67e00e7cd55f0b92f16681d", @@ -2043,12 +2068,15 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "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", + "equation_Prims.nonzero", "equation_Prims.pos", "int_inversion", + "pretyping_ae567c2fb75be05905677af440075565", + "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_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", + "typing_FStar.Mul.op_Star" ], 0 ], @@ -2106,11 +2134,12 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", "int_inversion", - "pretyping_ae567c2fb75be05905677af440075565", + "equation_Prims.nonzero", "equation_Prims.pos", "int_inversion", + "int_typing", "pretyping_ae567c2fb75be05905677af440075565", "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_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "typing_FStar.Mul.op_Star" @@ -2128,7 +2157,7 @@ [ "FStar.Math.Lemmas.modulo_modulo_lemma", 1, - 0, + 1, 1, [ "@query", "assumption_Prims.HasEq_int" ], 0 @@ -2136,7 +2165,7 @@ [ "FStar.Math.Lemmas.modulo_modulo_lemma", 2, - 0, + 1, 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.pos", @@ -2180,13 +2209,15 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", "int_inversion", "int_typing", - "pretyping_ae567c2fb75be05905677af440075565", + "equation_Prims.pos", + "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", + "int_typing", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c98d64f66bc1b384aab766348c37364a", - "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b" + "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", + "typing_Prims.pow2" ], 0 ], @@ -2205,12 +2236,13 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", + "equation_Prims.nonzero", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_2fd2ca5ba5888b39b1231badbe38fb2e", + "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", "typing_Prims.pow2" @@ -2226,7 +2258,7 @@ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", - "int_typing", "pretyping_ae567c2fb75be05905677af440075565", + "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_2fd2ca5ba5888b39b1231badbe38fb2e", @@ -2259,7 +2291,7 @@ 1, [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", - "equation_Prims.pos", "int_inversion", "int_typing", + "equation_Prims.pos", "int_inversion", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", @@ -2333,13 +2365,11 @@ 0, 1, [ - "@query", "equation_Prims.nat", "equation_Prims.nonzero", - "equation_Prims.pos", + "@query", "equation_Prims.nat", "equation_Prims.pos", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", "pretyping_ae567c2fb75be05905677af440075565", "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", - "refinement_interpretation_Tm_refine_7075614a0e8c0bdbec6de0d0ef7f1280", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c98d64f66bc1b384aab766348c37364a", "refinement_interpretation_Tm_refine_f048236b5f8051f83b495ea5eaa6127b", @@ -2355,9 +2385,9 @@ [ "@query", "equation_FStar.Mul.op_Star", "equation_Prims.nat", "fuel_correspondence_Prims.pow2.fuel_instrumented", "int_inversion", - "int_typing", "primitive_Prims.op_Addition", - "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", - "projection_inverse_BoxInt_proj_0", + "int_typing", "pretyping_ae567c2fb75be05905677af440075565", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", "refinement_interpretation_Tm_refine_ba523126f67e00e7cd55f0b92f16681d", "refinement_interpretation_Tm_refine_c98d64f66bc1b384aab766348c37364a" ], diff --git a/ulib/FStar.Monotonic.Seq.fst b/ulib/FStar.Monotonic.Seq.fst index eb481d5e732..45f4b6d6dc9 100644 --- a/ulib/FStar.Monotonic.Seq.fst +++ b/ulib/FStar.Monotonic.Seq.fst @@ -8,6 +8,12 @@ module HS = FStar.HyperStack module MR = FStar.Monotonic.RRef module SeqP = FStar.SeqProperties +(* 2016-11-22: The following is meant to override the fact that the + enclosing namespace of the current module (here FStar.Monotonic) is + automatically opened, which makes Seq resolve into + FStar.Monotonic.Seq instead of FStar.Seq. *) +module Seq = FStar.Seq + //////////////////////////////////////////////////////////////////////////////// abstract let seq_extension (#a:Type) (s1:seq a) (s2:seq a) (s3:seq a) = diff --git a/ulib/FStar.OrdMap.fst b/ulib/FStar.OrdMap.fst index 0195d871d3f..1edefccfbbf 100644 --- a/ulib/FStar.OrdMap.fst +++ b/ulib/FStar.OrdMap.fst @@ -11,7 +11,7 @@ type total_order (a:eqtype) (f: (a -> a -> Tot bool)) = let cmp (a:eqtype) = f:(a -> a -> Tot bool){total_order a f} abstract let map_t (k:eqtype) (v:eqtype) (f:cmp k) (d:ordset k f) = - g:(k -> Tot (option v)){(forall x. (mem x d = is_Some (g x)))} + g:(k -> Tot (option v)){(forall x. (mem x d = Some? (g x)))} abstract noeq type ordmap (k:eqtype) (v:eqtype) (f:cmp k) = | Mk_map: d:ordset k f -> m:map_t k v f d -> ordmap k v f @@ -44,30 +44,30 @@ let const_on (#k:eqtype) (#v:eqtype) #f d x = let g : k -> Tot (option v) = (fun y -> if mem y d then Some x else None) in Mk_map d g -let select (#k:eqtype) (#v:eqtype) #f x m = (Mk_map.m m) x +let select (#k:eqtype) (#v:eqtype) #f x m = (Mk_map?.m m) x let insert (#a:eqtype) (#f:cmp a) (x:a) (s:ordset a f) = union #a #f (singleton #a #f x) s let update (#k:eqtype) (#v:eqtype) #f x y m = - let s' = insert x (Mk_map.d m) in - let g' : k -> Tot (option v) = fun (x':k) -> if x' = x then Some y else (Mk_map.m m) x' in + let s' = insert x (Mk_map?.d m) in + let g' : k -> Tot (option v) = fun (x':k) -> if x' = x then Some y else (Mk_map?.m m) x' in Mk_map s' g' -let contains (#k:eqtype) (#v:eqtype) #f x m = mem x (Mk_map.d m) +let contains (#k:eqtype) (#v:eqtype) #f x m = mem x (Mk_map?.d m) -let dom (#k:eqtype) (#v:eqtype) #f m = (Mk_map.d m) +let dom (#k:eqtype) (#v:eqtype) #f m = (Mk_map?.d m) let remove (#k:eqtype) (#v:eqtype) #f x m = - let s' = remove x (Mk_map.d m) in - let g' : k -> Tot (option v) = fun x' -> if x' = x then None else (Mk_map.m m) x' in + let s' = remove x (Mk_map?.d m) in + let g' : k -> Tot (option v) = fun x' -> if x' = x then None else (Mk_map?.m m) x' in Mk_map s' g' let choose (#k:eqtype) (#v:eqtype) #f m = - match OrdSet.choose (Mk_map.d m) with + match OrdSet.choose (Mk_map?.d m) with | None -> None - | Some x -> Some (x, Some.v ((Mk_map.m m) x)) + | Some x -> Some (x, Some?.v ((Mk_map?.m m) x)) -let size (#k:eqtype) (#v:eqtype) #f m = OrdSet.size (Mk_map.d m) +let size (#k:eqtype) (#v:eqtype) #f m = OrdSet.size (Mk_map?.d m) abstract type equal (#k:eqtype) (#v:eqtype) (#f:cmp k) (m1:ordmap k v f) (m2:ordmap k v f) = (forall x. select #k #v #f x m1 = select #k #v #f x m2) @@ -115,7 +115,7 @@ abstract val sel_empty: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k abstract val sel_contains: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k -> m:ordmap k v f -> Lemma (requires (True)) - (ensures (contains #k #v #f x m = is_Some (select #k #v #f x m))) + (ensures (contains #k #v #f x m = Some? (select #k #v #f x m))) [SMTPat (select #k #v #f x m); SMTPat (contains #k #v #f x m)] abstract val contains_upd1: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k -> y:v -> x':k @@ -149,18 +149,18 @@ abstract val eq_remove: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k -> m:ordmap k [SMTPat (remove #k #v #f x m)] abstract val choose_empty: #k:eqtype -> #v:eqtype -> #f:cmp k - -> Lemma (requires True) (ensures (is_None (choose #k #v #f + -> Lemma (requires True) (ensures (None? (choose #k #v #f (empty #k #v #f)))) [SMTPat (choose #k #v #f (empty #k #v #f))] abstract val choose_m: #k:eqtype -> #v:eqtype -> #f:cmp k -> m:ordmap k v f -> Lemma (requires (~ (equal m (empty #k #v #f)))) - (ensures (is_Some (choose #k #v #f m) /\ - (select #k #v #f (fst (Some.v (choose #k #v #f m))) m = - Some (snd (Some.v (choose #k #v #f m)))) /\ - (equal m (update #k #v #f (fst (Some.v (choose #k #v #f m))) - (snd (Some.v (choose #k #v #f m))) - (remove #k #v #f (fst (Some.v (choose #k #v #f m))) m))))) + (ensures (Some? (choose #k #v #f m) /\ + (select #k #v #f (fst (Some?.v (choose #k #v #f m))) m = + Some (snd (Some?.v (choose #k #v #f m)))) /\ + (equal m (update #k #v #f (fst (Some?.v (choose #k #v #f m))) + (snd (Some?.v (choose #k #v #f m))) + (remove #k #v #f (fst (Some?.v (choose #k #v #f m))) m))))) [SMTPat (choose #k #v #f m)] abstract val size_empty: #k:eqtype -> #v:eqtype -> #f:cmp k @@ -182,12 +182,12 @@ abstract val dom_lemma: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k -> m:ordmap k abstract val contains_const_on: #k:eqtype -> #v:eqtype -> #f:cmp k -> d:ordset k f -> x:v -> y:k -> Lemma (requires (True)) (ensures (mem y d = contains y (const_on d x))) - //(contains y (const_on d x) ==> Some.v (select p w) = x))) + //(contains y (const_on d x) ==> Some?.v (select p w) = x))) [SMTPat (contains #k #v #f y (const_on #k #v #f d x))] abstract val select_const_on: #k:eqtype -> #v:eqtype -> #f:cmp k -> d:ordset k f -> x:v -> y:k -> Lemma (requires (True)) - (ensures (mem y d ==> (contains y (const_on d x) /\ Some.v (select y (const_on d x)) = x))) + (ensures (mem y d ==> (contains y (const_on d x) /\ Some?.v (select y (const_on d x)) = x))) [SMTPat (select #k #v #f y (const_on #k #v #f d x))] abstract val sel_rem1: #k:eqtype -> #v:eqtype -> #f:cmp k -> x:k -> m:ordmap k v f @@ -271,7 +271,7 @@ let choose_m (#k:eqtype) (#v:eqtype) #f m = let m' = remove #k #v #f x m in let (Mk_map s' g') = m' in let (Mk_map s'' g'') = update #k #v #f x y m' in - cut (feq (Mk_map.m m) g'') + cut (feq (Mk_map?.m m) g'') let size_empty (#k:eqtype) (#v:eqtype) #f = () diff --git a/ulib/FStar.OrdSet.fst b/ulib/FStar.OrdSet.fst index c0845dbdeb8..cde48d9a82b 100644 --- a/ulib/FStar.OrdSet.fst +++ b/ulib/FStar.OrdSet.fst @@ -35,23 +35,23 @@ abstract val singleton : #a:eqtype -> #f:cmp a -> a -> Tot (ordset a f) let mem (#a:eqtype) #f x s = List.Tot.mem x s private val set_props: - #a:eqtype -> #f:cmp a -> s:ordset a f{is_Cons s} + #a:eqtype -> #f:cmp a -> s:ordset a f{Cons? s} -> Lemma (requires (True)) - (ensures (forall x. mem #a #f x (Cons.tl s) ==> (f (Cons.hd s) x /\ Cons.hd s =!= x))) + (ensures (forall x. mem #a #f x (Cons?.tl s) ==> (f (Cons?.hd s) x /\ Cons?.hd s =!= x))) let rec set_props (#a:eqtype) #f s = match s with | x::tl -> if tl = [] then () else set_props #a #f tl -private val hd_unique: #a:eqtype -> #f:cmp a -> s:ordset a f{is_Cons s} - -> Lemma (requires (is_Cons s)) - (ensures (not (mem #a #f (Cons.hd s) (Cons.tl s)))) +private val hd_unique: #a:eqtype -> #f:cmp a -> s:ordset a f{Cons? s} + -> Lemma (requires (Cons? s)) + (ensures (not (mem #a #f (Cons?.hd s) (Cons?.tl s)))) let hd_unique (#a:eqtype) #f s = set_props #a #f s let empty (#a:eqtype) #f = [] private val insert': #a:eqtype -> #f:cmp a -> x:a -> s:ordset a f - -> Tot (l:(ordset a f){is_Cons l /\ - (Cons.hd l = x \/ - (is_Cons s /\ Cons.hd l = Cons.hd s))}) + -> Tot (l:(ordset a f){Cons? l /\ + (Cons?.hd l = x \/ + (Cons? s /\ Cons?.hd l = Cons?.hd s))}) let rec insert' (#a:eqtype) #f x s = match s with | [] -> [x] | hd::tl -> @@ -76,9 +76,9 @@ let choose (#a:eqtype) #f s = match s with | x::_ -> Some x private val remove': #a:eqtype -> #f:cmp a -> x:a -> s:ordset a f - -> Tot (l:(ordset a f){(is_Nil s ==> is_Nil l) /\ - (is_Cons s ==> Cons.hd s = x ==> l = Cons.tl s) /\ - (is_Cons s ==> Cons.hd s =!= x ==> (is_Cons l /\ Cons.hd l = Cons.hd s))}) + -> Tot (l:(ordset a f){(Nil? s ==> Nil? l) /\ + (Cons? s ==> Cons?.hd s = x ==> l = Cons?.tl s) /\ + (Cons? s ==> Cons?.hd s =!= x ==> (Cons? l /\ Cons?.hd l = Cons?.hd s))}) let rec remove' (#a:eqtype) #f x s = match s with | [] -> [] | hd::tl -> @@ -135,15 +135,15 @@ val mem_subset: #a:eqtype -> #f:cmp a -> s1:ordset a f -> s2:ordset a f [SMTPat (subset #a #f s1 s2)] val choose_empty: #a:eqtype -> #f:cmp a - -> Lemma (requires True) (ensures (is_None (choose #a #f (empty #a #f)))) + -> Lemma (requires True) (ensures (None? (choose #a #f (empty #a #f)))) [SMTPat (choose #a #f (empty #a #f))] (* TODO: FIXME: Pattern does not contain all quantified vars *) val choose_s: #a:eqtype -> #f:cmp a -> s:ordset a f -> Lemma (requires (not (s = (empty #a #f)))) - (ensures (is_Some (choose #a #f s) /\ - s = union #a #f (singleton #a #f (Some.v (choose #a #f s))) - (remove #a #f (Some.v (choose #a #f s)) s))) + (ensures (Some? (choose #a #f s) /\ + s = union #a #f (singleton #a #f (Some?.v (choose #a #f s))) + (remove #a #f (Some?.v (choose #a #f s)) s))) [SMTPat (choose #a #f s)] val mem_remove: #a:eqtype -> #f:cmp a -> x:a -> y:a -> s:ordset a f @@ -171,7 +171,7 @@ val size_singleton: #a:eqtype -> #f:cmp a -> x:a [SMTPat (size #a #f (singleton #a #f x))] private val eq_helper: #a:eqtype -> #f:cmp a -> x:a -> s:ordset a f - -> Lemma (requires (is_Cons s /\ f x (Cons.hd s) /\ x =!= Cons.hd s)) + -> Lemma (requires (Cons? s /\ f x (Cons?.hd s) /\ x =!= Cons?.hd s)) (ensures (not (mem #a #f x s))) let eq_helper (#a:eqtype) #f x s = set_props #a #f s diff --git a/ulib/FStar.OrdSetProps.fst b/ulib/FStar.OrdSetProps.fst index 3593505d570..c0b8adb124b 100644 --- a/ulib/FStar.OrdSetProps.fst +++ b/ulib/FStar.OrdSetProps.fst @@ -25,7 +25,7 @@ val union_lemma: #a:eqtype -> #f:cmp a -> s1:ordset a f -> s2:ordset a f let rec union_lemma (#a:eqtype) #f s1 s2 = if s1 = empty then () else - union_lemma (remove (Some.v (choose s1)) s1) s2 + union_lemma (remove (Some?.v (choose s1)) s1) s2 val union_lemma': #a:eqtype -> #f:cmp a -> s1:ordset a f -> s2:ordset a f -> Lemma (requires (True)) diff --git a/ulib/FStar.Relational.Comp.fst b/ulib/FStar.Relational.Comp.fst index daeca08d715..3144f12b8b0 100644 --- a/ulib/FStar.Relational.Comp.fst +++ b/ulib/FStar.Relational.Comp.fst @@ -22,8 +22,8 @@ val comp : (a:Type) -> (b:Type) -> (wp0:st_wp a) -> (wp1:st_wp b) -> Tot (st2_WP let comp a b wp0 wp1 p h2 = wp0 (fun y0 h0 -> wp1 (fun y1 h1 -> p (R y0 y1) (R h0 h1)) - (R.r h2)) - (R.l h2) + (R?.r h2)) + (R?.l h2) //TODO: this should be conditional on the monotonicity of the wps assume Monotone_comp: forall a b wp1 wp2 p1 p2. (forall x h. p1 x h ==> p2 x h) @@ -37,13 +37,13 @@ assume val compose2: #a0:Type -> #b0:Type -> #wp0:(a0 -> Tot (st_wp b0)) -> $c1:(x1:a1 -> STATE b1 (wp1 x1)) -> x: rel a0 a1 -> STATE2 (rel b0 b1) - (comp b0 b1 (wp0 (R.l x)) (wp1 (R.r x))) + (comp b0 b1 (wp0 (R?.l x)) (wp1 (R?.r x))) val compose2_self : #a:Type -> #b:Type -> #wp:(a -> Tot (st_wp b)) -> $c:(x:a -> STATE b (wp x)) -> x: double a -> STATE2 (double b) - (comp b b (wp (R.l x)) (wp (R.r x))) + (comp b b (wp (R?.l x)) (wp (R?.r x))) let compose2_self #a #b #wp f x = compose2 #a #b #wp #a #b #wp f f x (* Combine two ST2 statements A and B to create a new ST2 statement C where @@ -61,11 +61,11 @@ assume val cross : #a:Type -> #b:Type -> #c:Type -> #d:Type (requires (fun h -> p' h)) (ensures (fun h1 r h2 -> q' h1 r h2))) -> ST2 (rel a d) (requires (fun h -> (exists (hl:heap) (hr:heap). - p (R (R.l h) hr) - /\ p' (R hl (R.r h))))) + p (R (R?.l h) hr) + /\ p' (R hl (R?.r h))))) (ensures (fun h1 r h2 -> (exists (h2l:heap) (h2r:heap) (rl:c) (rr:b). - q h1 (R (R.l r) rr) (R (R.l h2) (h2r)) - /\ q' h1 (R rl (R.r r)) (R h2l (R.r h2))))) + q h1 (R (R?.l r) rr) (R (R?.l h2) (h2r)) + /\ q' h1 (R rl (R?.r r)) (R h2l (R?.r h2))))) (* Create a ST statment from a ST2 statement by projection *) @@ -74,7 +74,7 @@ val decomp_l : (a0:Type) -> (a1:Type) -> (b0:Type) -> (b1:Type) -> (al:a0) -> (w let decomp_l a0 a1 b0 b1 al wp = fun p hl -> (exists (ar:a1) (hr:heap). - wp (R al ar) (fun y2 h2 -> p (R.l y2) (R.l h2)) + wp (R al ar) (fun y2 h2 -> p (R?.l y2) (R?.l h2)) (R hl hr)) val decomp_r : (a0:Type) -> (a1:Type) -> (b0:Type) -> (b1:Type) -> (ar:a1) -> (wp:(rel a0 a1 -> Tot (st2_WP (rel b0 b1)))) @@ -82,7 +82,7 @@ val decomp_r : (a0:Type) -> (a1:Type) -> (b0:Type) -> (b1:Type) -> (ar:a1) -> (w let decomp_r a0 a1 b0 b1 ar wp = fun p hr -> (exists (al:a0) (hl:heap). - wp (R al ar) (fun y2 h2 -> p (R.r y2) (R.r h2)) + wp (R al ar) (fun y2 h2 -> p (R?.r y2) (R?.r h2)) (R hl hr)) assume val project_l : #a0:Type -> #b0:Type -> #a1:Type -> #b1:Type diff --git a/ulib/FStar.Relational.Relational.fst b/ulib/FStar.Relational.Relational.fst index 3b58678dae4..a13ce74fffd 100644 --- a/ulib/FStar.Relational.Relational.fst +++ b/ulib/FStar.Relational.Relational.fst @@ -7,7 +7,7 @@ type rel (a:Type) (b:Type) : Type = (* Some frequently used abbreviations *) type double (t:Type) = rel t t -type eq (t:Type) = p:(double t){R.l p == R.r p} +type eq (t:Type) = p:(double t){R?.l p == R?.r p} let twice x = R x x let tu = twice () @@ -38,7 +38,7 @@ let op_Hat_Star = rel_map2T (fun x y -> op_Multiply x y) let op_Hat_Slash = rel_map2T (fun x y -> x / y) (* Some convenient list functions *) -val tl_rel: #a:Type -> l:double (list a){is_Cons (R.l l) /\ is_Cons (R.r l)}-> Tot (double (list a)) +val tl_rel: #a:Type -> l:double (list a){Cons? (R?.l l) /\ Cons? (R?.r l)}-> Tot (double (list a)) let tl_rel #a (R (_::xs) (_::ys)) = R xs ys let cons_rel (R x y) (R xs ys) = R (x::xs) (y::ys) (* Some convenient tuple functions *) diff --git a/ulib/FStar.Seq.fst b/ulib/FStar.Seq.fst index c4ded280f93..90df7a24daf 100644 --- a/ulib/FStar.Seq.fst +++ b/ulib/FStar.Seq.fst @@ -25,19 +25,19 @@ abstract type seq (a:Type) = (* Destructors *) abstract val length: #a:Type -> seq a -> Tot nat -let length #a s = List.length (MkSeq.l s) +let length #a s = List.length (MkSeq?.l s) abstract val index: #a:Type -> s:seq a -> i:nat{i < length s} -> Tot a -let index #a s i = List.index (MkSeq.l s) i +let index #a s i = List.index (MkSeq?.l s) i private val cons: #a:Type -> x:a -> s:seq a -> Tot (seq a) -let cons #a x s = MkSeq (x::(MkSeq.l s)) +let cons #a x s = MkSeq (x::(MkSeq?.l s)) -private val hd: #a:Type -> s:seq a{is_Cons (MkSeq.l s)} -> Tot a -let hd #a s = List.hd (MkSeq.l s) +private val hd: #a:Type -> s:seq a{Cons? (MkSeq?.l s)} -> Tot a +let hd #a s = List.hd (MkSeq?.l s) -private val tl: #a:Type -> s:seq a{is_Cons (MkSeq.l s)} -> Tot (seq a) -let tl #a s = MkSeq (List.tl (MkSeq.l s)) +private val tl: #a:Type -> s:seq a{Cons? (MkSeq?.l s)} -> Tot (seq a) +let tl #a s = MkSeq (List.tl (MkSeq?.l s)) abstract val create: #a:Type -> nat -> a -> Tot (seq a) let rec create #a len v = if len = 0 then MkSeq [] else cons v (create (len - 1) v) @@ -71,7 +71,7 @@ abstract val upd: #a:Type -> s:seq a -> n:nat{n < length s} -> a -> Tot (seq a) let rec upd #a s n v = if n = 0 then cons v (tl s) else cons (hd s) (upd (tl s) (n - 1) v) abstract val append: #a:Type -> seq a -> seq a -> Tot (seq a) -let append #a s1 s2 = MkSeq (List.append (MkSeq.l s1) (MkSeq.l s2)) +let append #a s1 s2 = MkSeq (List.append (MkSeq?.l s1) (MkSeq?.l s2)) let op_At_Bar (#a:Type) (s1:seq a) (s2:seq a) = append s1 s2 @@ -105,7 +105,7 @@ abstract val lemma_len_append: #a:Type -> s1:seq a -> s2:seq a -> Lemma (requires True) (ensures (length (append s1 s2) = length s1 + length s2)) [SMTPat (length (append s1 s2))] -let lemma_len_append #a s1 s2 = FStar.ListProperties.append_length (MkSeq.l s1) (MkSeq.l s2) +let lemma_len_append #a s1 s2 = FStar.ListProperties.append_length (MkSeq?.l s1) (MkSeq?.l s2) abstract val lemma_len_slice: #a:Type -> s:seq a -> i:nat -> j:nat{i <= j && j <= length s} -> Lemma (requires True) @@ -136,7 +136,7 @@ abstract val lemma_index_upd2: #a:Type -> s:seq a -> n:nat{n < length s} -> v:a (requires True) (ensures (index (upd s n v) i == index s i)) (decreases (length s)) [SMTPat (index (upd s n v) i)] -let rec lemma_index_upd2 #a s n v i = match (MkSeq.l s) with +let rec lemma_index_upd2 #a s n v i = match (MkSeq?.l s) with | [] -> () | hd::tl -> if i = 0 then () @@ -148,7 +148,7 @@ abstract val lemma_index_app1: #a:Type -> s1:seq a -> s2:seq a -> i:nat{i < leng (requires True) (ensures (index (append s1 s2) i == index s1 i)) (decreases (length s1)) [SMTPat (index (append s1 s2) i)] -let rec lemma_index_app1 #a s1 s2 i = match (MkSeq.l s1) with +let rec lemma_index_app1 #a s1 s2 i = match (MkSeq?.l s1) with | [] -> () | hd::tl -> if i = 0 then () else lemma_index_app1 #a (MkSeq tl) s2 (i - 1) diff --git a/ulib/FStar.SquashProperties.fst b/ulib/FStar.SquashProperties.fst index 9b95a61d52d..ffdd70b7708 100644 --- a/ulib/FStar.SquashProperties.fst +++ b/ulib/FStar.SquashProperties.fst @@ -80,7 +80,7 @@ noeq type retract_cond 'a 'b : Type = (* unused below *) val ac: r:retract_cond 'a 'b -> retract 'a 'b -> x:'a -> - GTot (ceq ((MkC.j2 r) (MkC.i2 r x)) x) + GTot (ceq ((MkC?.j2 r) (MkC?.i2 r x)) x) let ac (MkC _ _ inv2) = inv2 let false_elim (#a:Type) (f:False) : Tot a @@ -111,8 +111,8 @@ assume val f : u -> Tot (squash (pow u)) // val g : squash (pow U) -> Tot U // let g sh = fun (x:Type) -> -// let (slX:squash (pow U -> Tot (pow x))) = map_squash (l1 x U) MkC.j2 in -// let (srU:squash (pow U -> Tot (pow U))) = map_squash (l1 U U) MkC.i2 in +// let (slX:squash (pow U -> Tot (pow x))) = map_squash (l1 x U) MkC?.j2 in +// let (srU:squash (pow U -> Tot (pow U))) = map_squash (l1 U U) MkC?.i2 in // bind_squash srU (fun rU -> // bind_squash slX (fun lX -> // bind_squash sh (fun h -> diff --git a/ulib/FStar.Util.fst b/ulib/FStar.Util.fst index 30f8ecf09a7..8b3fe3b1fb9 100644 --- a/ulib/FStar.Util.fst +++ b/ulib/FStar.Util.fst @@ -1,11 +1,14 @@ module FStar.Util +open FStar.Heap +open FStar.HyperHeap + +(* 2016-11-22: the following MUST be defined here AFTER the above `open', + since they are used in [op_At_Plus_At] below *) let op_Plus_Plus x y = TSet.union x y let op_Plus_Plus_Hat x y = x ++ (TSet.singleton y) let op_Hat_Plus_Hat x y = (TSet.singleton x) ++ (TSet.singleton y) -open FStar.Heap -open FStar.HyperHeap let op_At_Plus_At (#a:Type) (#r:rid) (#b:Type) (#s:rid) (x:rref r a) (y:rref s b) = Ref (as_ref x) ^+^ Ref (as_ref y) let op_Plus_Plus_At (#a:Type) (#r:rid) (x:TSet.set aref) (y:rref r a) = x ++^ Ref (as_ref y) diff --git a/ulib/fs/native_int/prims.fs b/ulib/fs/native_int/prims.fs index 129652e63ff..f7ea728fe93 100644 --- a/ulib/fs/native_int/prims.fs +++ b/ulib/fs/native_int/prims.fs @@ -25,24 +25,24 @@ module Prims | Left of ' p | Right of ' q - let is_Left = function + let uu___is_Left = function | Left _ -> true | _ -> false - let is_Right = function + let uu___is_Right = function | Right _ -> true | _ -> false type (' p, ' q) l_and = | And of ' p * ' q - let is_And = function + let uu___is_And = function | And _ -> true type l__True = | T - let is_T = function + let uu___is_T = function | T -> true type l__False = unit @@ -101,8 +101,8 @@ module Prims let op_disEquality x y = x<>y let op_AmpAmp x y = x && y let op_BarBar x y = x || y - let is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) - let is_Cons l = not (is_Nil l) + let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) + let uu___is_Cons l = not (uu___is_Nil l) let raise e = raise e let string_of_bool b = sprintf "%b" b let string_of_int i = sprintf "%d" i diff --git a/ulib/fs/prims.fs b/ulib/fs/prims.fs index e72b144995e..c5e45668771 100644 --- a/ulib/fs/prims.fs +++ b/ulib/fs/prims.fs @@ -25,24 +25,24 @@ module Prims | Left of ' p | Right of ' q - let is_Left = function + let uu___is_Left = function | Left _ -> true | _ -> false - let is_Right = function + let uu___is_Right = function | Right _ -> true | _ -> false type (' p, ' q) l_and = | And of ' p * ' q - let is_And = function + let uu___is_And = function | And _ -> true type l__True = | T - let is_T = function + let uu___is_T = function | T -> true type l__False = unit @@ -101,8 +101,8 @@ module Prims let op_disEquality x y = x<>y let op_AmpAmp x y = x && y let op_BarBar x y = x || y - let is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) - let is_Cons l = not (is_Nil l) + let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) + let uu___is_Cons l = not (uu___is_Nil l) let raise e = raise e let string_of_bool b = sprintf "%b" b let string_of_int i = sprintf "%d" i diff --git a/ulib/hyperheap/FStar.All.fst b/ulib/hyperheap/FStar.All.fst index 53dda2852a7..a7bb772071a 100644 --- a/ulib/hyperheap/FStar.All.fst +++ b/ulib/hyperheap/FStar.All.fst @@ -35,6 +35,6 @@ effect ML (a:Type) = assume val pipe_right: 'a -> ('a -> 'b) -> 'b assume val pipe_left: ('a -> 'b) -> 'a -> 'b -assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> is_Err a /\ h==h') +assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h') assume val exit: int -> 'a assume val try_with: (unit -> 'a) -> (exn -> 'a) -> 'a diff --git a/ulib/hyperstack/FStar.All.fst b/ulib/hyperstack/FStar.All.fst index e6eab74ccba..e7e9a8c67de 100644 --- a/ulib/hyperstack/FStar.All.fst +++ b/ulib/hyperstack/FStar.All.fst @@ -35,6 +35,6 @@ effect ML (a:Type) = assume val pipe_right: 'a -> ('a -> 'b) -> 'b assume val pipe_left: ('a -> 'b) -> 'a -> 'b -assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> is_Err a /\ h==h') +assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h') assume val exit: int -> 'a assume val try_with: (unit -> 'a) -> (exn -> 'a) -> 'a diff --git a/ulib/ml/prims.ml b/ulib/ml/prims.ml index cefce98f303..cf4aa551795 100644 --- a/ulib/ml/prims.ml +++ b/ulib/ml/prims.ml @@ -33,21 +33,21 @@ type (' p, ' q) c_or = type (' p, ' q) l_or = (' p, ' q) c_or -let is_Left = function Left _ -> true | Right _ -> false +let uu___is_Left = function Left _ -> true | Right _ -> false -let is_Right = function Left _ -> false | Right _ -> true +let uu___is_Right = function Left _ -> false | Right _ -> true type (' p, ' q) c_and = | And of ' p * ' q type (' p, ' q) l_and = (' p, ' q) c_and -let is_And _ = true +let uu___is_And _ = true type l_True = | T -let is_T _ = true +let uu___is_T _ = true type l_False = unit (*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there @@ -93,16 +93,16 @@ let op_Equality x y = x = y let op_disEquality x y = x<>y let op_AmpAmp x y = x && y let op_BarBar x y = x || y -let is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) -let is_Cons l = not (is_Nil l) +let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) +let uu___is_Cons l = not (uu___is_Nil l) let strcat x y = x ^ y -let is_Some = function (*consider redefining Option.isSome as this function*) +let uu___is_Some = function (*consider redefining Option.isSome as this function*) | Some _ -> true | None -> false -let is_None o = not (is_Some o) +let uu___is_None o = not (uu___is_Some o) let raise e = raise e -let ___Some___v x = match x with +let __proj__Some__item__v x = match x with | Some v -> v | None -> failwith "impossible" @@ -110,17 +110,17 @@ type ('a, 'b) either = | Inl of 'a | Inr of 'b -let is_Inl = function +let uu___is_Inl = function | Inl _ -> true | _ -> false -let is_Inr x = not (is_Inl x) +let uu___is_Inr x = not (uu___is_Inl x) -let ___Inl___v x = match x with +let __proj__Inl__item__v x = match x with | Inl v -> v | _ -> failwith "impossible" -let ___Inr___v x = match x with +let __proj__Inr__item__v x = match x with | Inr v -> v | _ -> failwith "impossible" @@ -143,7 +143,7 @@ let rec pow2 n = else ~$2 * pow2 (n - ~$1) -let ___Cons___tl = function +let __proj__Cons__item__tl = function | _::tl -> tl | _ -> failwith "Impossible" diff --git a/ulib/prims.fst b/ulib/prims.fst index 3540c47b187..46f36efacc3 100644 --- a/ulib/prims.fst +++ b/ulib/prims.fst @@ -344,8 +344,8 @@ unfold let ex_bind_wp (r1:range) (a:Type) (b:Type) : GTot Type0 = forall (k:ex_post b). (forall (rb:result b).{:pattern (guard_free (k rb))} k rb <==> p rb) - ==> (wp1 (fun ra1 -> (is_V ra1 ==> wp2 (V.v ra1) k) - /\ (is_E ra1 ==> k (E (E.e ra1))))) + ==> (wp1 (fun ra1 -> (V? ra1 ==> wp2 (V?.v ra1) k) + /\ (E? ra1 ==> k (E (E?.e ra1))))) unfold let ex_ite_wp (a:Type) (wp:ex_wp a) (post:ex_post a) = forall (k:ex_post a). @@ -402,7 +402,7 @@ unfold let all_bind_wp (heap:Type) (r1:range) (a:Type) (b:Type) (wp1:all_wp_h heap a) (wp2:(a -> GTot (all_wp_h heap b))) (p:all_post_h heap b) (h0:heap) : GTot Type0 = - wp1 (fun ra h1 -> (is_V ra ==> wp2 (V.v ra) p h1)) h0 + wp1 (fun ra h1 -> (V? ra ==> wp2 (V?.v ra) p h1)) h0 unfold let all_if_then_else (heap:Type) (a:Type) (p:Type) (wp_then:all_wp_h heap a) (wp_else:all_wp_h heap a) @@ -604,16 +604,16 @@ let as_requires (#a:Type) (wp:pure_wp a) = wp (fun x -> True) let as_ensures (#a:Type) (wp:pure_wp a) (x:a) = ~ (wp (fun y -> (y=!=x))) val fst : ('a * 'b) -> Tot 'a -let fst x = Mktuple2._1 x +let fst x = Mktuple2?._1 x val snd : ('a * 'b) -> Tot 'b -let snd x = Mktuple2._2 x +let snd x = Mktuple2?._2 x val dfst : #a:Type -> #b:(a -> GTot Type) -> dtuple2 a b -> Tot a -let dfst #a #b t = Mkdtuple2._1 t +let dfst #a #b t = Mkdtuple2?._1 t -val dsnd : #a:Type -> #b:(a -> GTot Type) -> t:dtuple2 a b -> Tot (b (Mkdtuple2._1 t)) -let dsnd #a #b t = Mkdtuple2._2 t +val dsnd : #a:Type -> #b:(a -> GTot Type) -> t:dtuple2 a b -> Tot (b (Mkdtuple2?._1 t)) +let dsnd #a #b t = Mkdtuple2?._2 t assume val _assume : p:Type -> unit -> Pure unit (requires (True)) (ensures (fun x -> p)) assume val admit : #a:Type -> unit -> Admit a @@ -641,7 +641,7 @@ let allow_inversion (a:Type) //allowing inverting option without having to globally increase the fuel just for this val invertOption : a:Type -> Lemma (requires True) - (ensures (forall (x:option a). is_None x \/ is_Some x)) + (ensures (forall (x:option a). None? x \/ Some? x)) [SMTPatT (option a)] let invertOption a = allow_inversion (option a)