Using the normalizer to reduce a recursive function - fstar

I want to prove a property parameterized over a finite number of cases. I would like to divide the problem to one instance per case and solve each instance separately. Here is an example to clear up things:
module Minimal
open FStar.List
open FStar.Tactics
open FStar.Reflection.Data
unfold let lst = [0;1]
unfold let prop i =
match i with
| 0 -> i == 0
| 1 -> i == 1
| _ -> False
val propHolds (i:int) : Lemma (requires (List.mem i lst)) (ensures (prop i))
In this case the cases are defined by the list lst.
I can easily prove propHolds:
let propHolds i =
assert_by_tactic (prop 0) (fun () -> norm[delta;primops;iota;zeta]; dump "normalized"; trivial ());
assert_by_tactic (prop 1) (fun () -> norm[delta;primops;iota;zeta]; dump "normalized"; trivial ())
but I obviously don't want to write a separate assert_by_tactic for each case (not when there may be thousands..).
I somehow want to generate the proof above automatically for all elements in lst.
I tried various things, here is one of them:
assert_by_tactic (let rec props i =
if i = 0 then prop 0
else (prop i) /\ (props (i-1))
in
props 1) (fun () -> norm[delta;primops;iota;zeta]; dump "normalized")
Unfortunately, this doesn't quite achieve what I would like, the assert_by_tactic fails (and is not reduced in the way I would expect). I think I am missing something obvious about normalization, but what is the canonical way to do this in F*? Bonus points if the solution points to the "case"/assertion that failed if there exists one.

F*'s type system only ensures weak normalization of terms. Well-typed open terms can diverge, e.g., when reduced in an inconsistent context. To guard against this, the F* normalizer employs various heuristics and, by default, conservatively refuses to reduce recursive calls in the bodies of unreduced matches. This is what prevents List.mem from reducing fully to a cascade of unreduced if/then/else's (if/then/else is just sugar for a match on a Boolean).
List.memP, a related function from F*'s standard library is more reduction friendly in this case, since it does not block on unreduced matches internally. Note, List.memP need not always be more reduction friendly than List.mem---the latter is Boolean, so it can in some cases compute more (e.g., List.mem 3 [1;2;3] will reduce just fine to true);
Try this program:
module Minimal
open FStar.Tactics
let lst = [0;1;2;3;4;5;6;7;8;9;10]
let prop i =
match i with
| 0 -> i == 0
| 1 -> i == 1
| 2 -> i == 2
| 3 -> i == 3
| 4 -> i == 4
| 5 -> i == 5
| 6 -> i == 6
| 7 -> i == 7
| 8 -> i == 8
| 9 -> i == 9
| 10 -> i == 10
| _ -> False
let propHolds (i:int) =
assert (List.memP i lst ==> prop i)
by (dump "A";
norm [delta_only [`%List.memP; `%lst]; iota; zeta; simplify];
dump "B")
At dump B, you'll see the hypothesis reduced to a nested disjunction. Z3 can prove the goal easily from there.
Here's another way to do it, this time without tactics.
let trigger_norm (a:Type)
: Lemma
(requires a)
(ensures (Pervasives.norm [delta_only [`%List.memP; `%lst]; iota; zeta; simplify] a))
= ()
let propHolds (i:int)
: Lemma
(requires List.memP i lst)
(ensures prop i)
= trigger_norm (List.memP i lst)
Now, in response to jebus' comment below, you can go further and prove the postcondition using a tactic, although, the SMT solver is really pretty fast at doing this … so I wouldn't use a tactic for this unless you had some specific strong reason for doing so.
Here's one more solution:
module SO
open FStar.Tactics
let lst = [0;1;2;3;4;5;6;7;8;9;10]
let pred i =
match i with
| 0 -> i == 0
| 1 -> i == 1
| 2 -> i == 2
| 3 -> i == 3
| 4 -> i == 4
| 5 -> i == 5
| 6 -> i == 6
| 7 -> i == 7
| 8 -> i == 8
| 9 -> i == 9
| 10 -> i == 10
| _ -> False
let case_impl (a b c:Type)
: Lemma
(requires (a ==> c) /\ (b ==> c))
(ensures (a \/ b) ==> c)
= ()
let solve_pred_impl () : Tac unit =
let eq = implies_intro () in
rewrite eq;
norm [delta_only [`%pred]; iota];
trivial()
let test i =
assert (List.memP i lst ==> pred i)
by (norm [delta_only [`%List.memP; `%lst]; iota; zeta; simplify];
let _ = repeat
(fun () ->
mapply (`case_impl);
split();
solve_pred_impl()) in
solve_pred_impl())

Related

unable to understand why im not getting the proper output

I've written a code for streams of factorial.
type 'a lazee = 'a hidden ref
and 'a hidden = Value of 'a
| Thunk of (unit -> 'a)
let demand (l: 'a lazee) : 'a =
force l;
match !l with
| Value v -> v
| Thunk f -> raise (Failure "shouldn't happen like this")
let force (l: 'a lazee) : unit = match !l with
| Value _ -> ()
| Thunk f -> l := Value (f ())
let rec zip (f: 'a -> 'b -> 'c) (s1: 'a stream) (s2: 'b stream) : 'c stream =
match s1, s2 with
| Cons (h1, t1), Cons (h2, t2) ->
Cons (f h1 h2, delay (fun () -> zip f (demand t1) (demand t2)))
let delay (unit_to_x: unit -> 'a) : 'a lazee =
ref (Thunk unit_to_x)
let nats = from 1
let mul_p x y =
let () = print_endline ("multiplying " ^ string_of_int x ^ " and " ^
string_of_int y ^ ".")
in x * y
let rec factorials () =
Cons (1, delay (fun () -> zip mul_p nats (factorials ())))
let facts = factorials ()
I want to get the output like this,
multiplying 1 and 1.
multiplying 2 and 1.
multiplying 3 and 2.
multiplying 4 and 6.
multiplying 5 and 24.
the above output generates when I execute the following command in file itself: let () =
assert (take 5 facts = [1; 1; 2; 6; 24])
but when I execute the file in OCaml, I get multiple multiplications like this,
multiplying 1 and 1.
multiplying 1 and 1.
multiplying 2 and 1.
multiplying 2 and 1.
multiplying 3 and 2.
multiplying 1 and 1.
multiplying 2 and 1.
multiplying 3 and 2.
multiplying 4 and 6.
multiplying 1 and 1.
multiplying 2 and 1.
multiplying 3 and 2.
multiplying 4 and 6.
multiplying 5 and 24.
can someone fix this for me, I've tried several trial and errors but couldn't figure it out. thanks!
Assuming your implementation of demand is correct, your problem is indeed your definition of factorials:
let rec factorials () =
Cons (1, delay (fun () -> zip mul_p nats (factorials ())))
Here, the inner call to factorials () recreate a new stream value with a fresh inner reference and thus lose all sharing with the external call. Consequently, it needs to recompute all previously computed value of factorials without any memoization.
Thus, we need to define factorials as a single recursive value
let rec factorials =
Cons(1, ref (Thunk (fun () -> zip mul_p nats factorials)))
Note that the function delay cannot used directly because the recursive value analyzer needs to be convinced that the recursive value, factorial, is correctly used in its own body.

Why this program dosen't halt when only need to iterating throught a finite stream?

I'm trying to get a list of primes of two digits by running these codes in LearnOcaml. The codes compile if I restrict the parameter of the listify method, which returns a list from a stream, to be less than 20. Otherwise, it either never halt or return "Exception: Js_of_ocaml__Js.Error _.". I don't think the code is semantically wrong. So I'm
wondering if anyone can help resolve the problem?
type 'a stream = Eos | StrCons of 'a*(unit -> 'a stream)
(*integers from n onwards*)
let rec nums_from n =
StrCons(n,fun () -> nums_from (n+1))
let rec filterStr (test : 'a -> bool) (s: 'a stream) =
match s with
|Eos -> Eos
|StrCons(q,w) -> if test q then StrCons(q,fun ()-> filterStr test (w ()))
else filterStr test (w ())
(*Remove all numbers mod p*)
let sift p =
filterStr (fun x -> x mod p <> 0)
(*Sieves*)
let rec sieves s =
match s with
|Eos ->Eos
|StrCons(x,g) -> StrCons(x, fun ()-> sieves (sift x (g ())))
(*primes*)
let allprimes = sieves (nums_from 2)
let rec listify s n=
if n =0 then [] else
match s with
|Eos -> []
|StrCons(q,w) -> q::(listify (w ()) (n-1))
let twodigitsprimes = filterStr (fun x -> x > 10&& x<100) allprimes
let twodigitsprimeslist= listify twodigitsprimes 21
It appears that filterStr is looping while trying to create the StrCons that represents the next element after the 21st. Since there are only 21 2-digit primes, this will loop forever.
Note that when listify is called with n = 0, the StrCons has already been constructed; it just isn't examined. But the StrCons for this case diverges (and OCaml is a strict language).
You can get things to work using this version of listify:
let rec listify s n =
if n = 0 then []
else
match s with
| Eos -> []
| StrCons (q, w) ->
if n = 1 then [q] else q :: listify (w ()) (n - 1)

Declaring function using function in F#

I'm trying to understand the following code to declare a function:
let string_of_int = function
| 0 -> "zero"
| 1 -> "one"
| 2 -> "two"
| _ -> "many"
which is the same as
let string_of_int2 x = match x with
|0 -> "zero"
|1 -> "one"
| 2-> "two"
_ -> "many
I understand The second way of declaring the function with is trying to match the input x with several possibilities that it could be. But I don't understand the first way to do it. What does function keyword do?
Also,
what does 'a'..'z' do in the following code?
let is_capital = function
| 'a'..'z' -> false
| 'A'..'Z' -> true
|_ -> failwith "Not a valid letter"
Why can't I have a function like this:
let examplefunc = function
|"string"-> Printf.printf "a string"
|3 -> Printf.print "an integer"
|true-> Printf.printf "a boolean"
|- -> Printf.printf "whatever"
The function keyword is a variant of fun that takes in account that the behavior of the function often directly depends on the value of the argument. For instance, if we start with the following definition of the factorial function:
For a positive integer n, n! is 1 if n = 0, and n * (n-1)! otherwise
then the natural translation to OCaml is
let factorial = function
| 0 (* if n = 0 *) -> 1
| n (* otherwise *) -> n * factorial (n-1)
like you said this strictly equivalent to
let factorial = fun n -> match n with
| 0 (* if n = 0 *) -> 1
| n (* otherwise *) -> n * factorial (n-1)
but when the argument of the function is immediately deconstructed in a pattern matching, it may be more readable to use function directly.
Concerning '0'..'9', those are range pattern that matches all characters (i.e '0'|'1'|'2'|'3'|'4'|..| '9' between the lower and upper bounds (included) of the range (following the ascii ordering of characters)
let is_digit = function '0'..'9' -> true | _ -> false
is_digit '0' (* returns true *);;
is_digit 'a' (* returns false *);;

how to implement lambda-calculus in OCaml?

In OCaml, it seems that "fun" is the binding operator to me. Does OCaml have built-in substitution? If does, how it is implemented? is it implemented using de Bruijn index?
Just want to know how the untyped lambda-calculus can be implemented in OCaml but did not find such implementation.
As Bromind, I also don't exactly understand what you mean by saying "Does OCaml have built-in substitution?"
About lambda-calculus once again I'm not really understand but, if you talking about writing some sort of lambda-calculus interpreter then you need first define your "syntax":
(* Bruijn index *)
type index = int
type term =
| Var of index
| Lam of term
| App of term * term
So (λx.x) y will be (λ 0) 1 and in our syntax App(Lam (Var 0), Var 1).
And now you need to implement your reduction, substitution and so on. For example you may have something like this:
(* identity substitution: 0 1 2 3 ... *)
let id i = Var i
(* particular case of lift substitution: 1 2 3 4 ... *)
let lift_one i = Var (i + 1)
(* cons substitution: t σ(0) σ(1) σ(2) ... *)
let cons (sigma: index -> term) t = function
| 0 -> t
| x -> sigma (x - 1)
(* by definition of substitution:
1) x[σ] = σ(x)
2) (λ t)[σ] = λ(t[cons(0, (σ; lift_one))])
where (σ1; σ2)(x) = (σ1(x))[σ2]
3) (t1 t2)[σ] = t1[σ] t2[σ]
*)
let rec apply_subs (sigma: index -> term) = function
| Var i -> sigma i
| Lam t -> Lam (apply_subs (function
| 0 -> Var 0
| i -> apply_subs lift_one (sigma (i - 1))
) t)
| App (t1, t2) -> App (apply_subs sigma t1, apply_subs sigma t2)
As you can see OCaml code is just direct rewriting of definition.
And now small-step reduction:
let is_value = function
| Lam _ | Var _ -> true
| _ -> false
let rec small_step = function
| App (Lam t, v) when is_value v ->
apply_subs (cons id v) t
| App (t, u) when is_value t ->
App (t, small_step u)
| App (t, u) ->
App (small_step t, u)
| t when is_value t ->
t
| _ -> failwith "You will never see me"
let rec eval = function
| t when is_value t -> t
| t -> let t' = small_step t in
if t' = t then t
else eval t'
For example you can evaluate (λx.x) y:
eval (App(Lam (Var 0), Var 1))
- : term = Var 1
OCaml does not perform normal-order reduction and uses call-by-value semantics. Some terms of lambda calculus have a normal form than cannot be reached with this evaluation strategy.
See The Substitution Model of Evaluation, as well as How would you implement a beta-reduction function in F#?.
I don't exactly understand what you mean by saying "Does OCaml have built-in substitution? ...", but concerning how the lambda-calculus can be implemented in OCaml, you can indeed use fun : just replace all the lambdas by fun, e.g.:
for the church numerals: you know that zero = \f -> (\x -> x), one = \f -> (\x -> f x), so in Ocaml, you'd have
let zero = fun f -> (fun x -> x)
let succ = fun n -> (fun f -> (fun x -> f (n f x)))
and succ zero gives you one as you expect it, i.e. fun f -> (fun x -> f x) (to highlight it, you can for instance try (succ zero) (fun s -> "s" ^ s) ("0") or (succ zero) (fun s -> s + 1) (0)).
As far as I remember, you can play with let and fun to change the evaluation strategy, but to be confirmed...
N.B.: I put all parenthesis just to make it clear, maybe some can be removed.

Match Failure Issue OCaml

I'm getting a match failure for my OCaml code and I have no idea what the issue might be. I attempted having one case only and going from there to figure out where the issue comes up but the error I receive is :
Exception: Match_failure ("hw2.ml", 49, 0).
Code :
let rec compileStack(il : instr list) (st : float list) =
match (il,st) with
[],[_] -> List.hd st
|((Push f)::t),[_] -> compileStack t (f::st)
|(Swap)::t, h2::h1::st -> compileStack t (h2::h1::st)
|(Calculate op)::t, h1::h2::st ->
match op with
Plus -> compileStack t (h2+.h1::st)
| Minus -> compileStack t (h2-.h1::st)
| Times -> compileStack t (h2*.h1::st)
| Divide -> compileStack t (h2/.h1::st) ;;
let execute (li : instr list) : float =
let stack = [] in
compileStack li stack;;
Any suggestion will be highly appreciated, been stuck on this for 2 hours now.
When compiling pay attention to the compiler's output. If it says something like
Warning ...: this pattern-matching is not exhaustive.
then it usually means you skipped some cases. By the way, the compiler provides an example of missed cases.
Considering your problem, I'd separate different jobs into different functions -- that will let you handle those cases easier; also don't forget about stack underflows, which happen when there is not enough data in the stack to perform swaps or binary arithmetic operations. See the example below.
(* just type aliases for convenience *)
type stack = float list
type binop = float -> float -> float
(* helper function to prevent nested pattern matching below *)
let denote_operation (op : oper) : binop =
match op with
| Plus -> ( +. )
| Minus -> ( -. )
| Times -> ( *. )
| Divide -> ( /. )
(* This function executes only 1 instruction and
returns 'stack option', which may signal stack underflow *)
let execute_instruction (i : instr) (st : stack) : stack option =
match i with
| Push f -> Some (f :: st)
| Swap ->
(match st with
| y :: x :: st' -> Some (x :: y :: st')
| _ -> None)
| Calculate op ->
(match st with
| y :: x :: st' -> Some ((denote_operation op x y) :: st')
| _ -> None)
(* this function deals with a bunch of instructions *)
let rec execute_program (il : instr list) (st : stack) : stack option =
match il with
| [] -> Some st
| i :: il' ->
match (execute_instruction i st) with
| None -> None
| Some st' -> execute_program il' st'