I have a dictionary of operations:
type INumerics<'T> =
abstract Zer : 'T
abstract Add : 'T * 'T -> 'T
abstract Sub : 'T * 'T -> 'T
abstract Mul : 'T * 'T -> 'T
abstract Div : 'T * 'T -> 'T
abstract Neq : 'T * 'T -> bool
With helper functions:
let inline add (x : 'T) (y : 'T) : 'T = (+) x y
let inline sub (x : 'T) (y : 'T) : 'T = (-) x y
let inline mul (x : 'T) (y : 'T) : 'T = (*) x y
let inline div (x : 'T) (y : 'T) : 'T = (/) x y
let inline neq (x : 'T) (y : 'T) : bool = (<>) x y
Then we have a simple calculator using a MailboxProcessor agent:
type Agent<'T> = MailboxProcessor<'T>
type CalculatorMsg<'T> =
| Add of 'T * 'T * AsyncReplyChannel<'T>
| Sub of 'T * 'T * AsyncReplyChannel<'T>
| Mul of 'T * 'T * AsyncReplyChannel<'T>
| Div of 'T * 'T * AsyncReplyChannel<'T>
type CalculatorAgent< ^T when ^T : (static member get_Zero : unit -> ^T)
and ^T : (static member Zero : ^T)
and ^T : (static member (+) : ^T * ^T -> ^T)
and ^T : (static member (-) : ^T * ^T -> ^T)
and ^T : (static member (*) : ^T * ^T -> ^T)
and ^T : (static member (/) : ^T * ^T -> ^T)
and ^T : equality >() =
let agent =
let ops =
{ new INumerics<'T> with
member ops.Zer = LanguagePrimitives.GenericZero<'T>
member ops.Add(x, y) = (x, y) ||> add
member ops.Sub(x, y) = (x, y) ||> sub
member ops.Mul(x, y) = (x, y) ||> mul
member ops.Div(x, y) = (x, y) ||> div
member ops.Neq(x, y) = (x, y) ||> neq }
Agent<CalculatorMsg<'T>>.Start(fun inbox ->
let rec loop () =
async {
let! msg = inbox.TryReceive()
if msg.IsSome then
match msg.Value with
| Add (x, y, rep) ->
printfn "Adding %A and %A ..." x y
let res = ops.Add(x, y)
res |> rep.Reply
return! loop()
| Sub (x, y, rep) ->
printfn "Subtracting %A from %A ..." y x
let res = ops.Sub(x, y)
res |> rep.Reply
return! loop()
| Mul (x, y, rep) ->
printfn "Multiplying %A by %A ... " y x
let res = ops.Mul(x, y)
res |> rep.Reply
return! loop()
| Div (x, y, rep) ->
printfn "Dividing %A by %A ..." x y
if ops.Neq(y, ops.Zer) then
let res = ops.Div(x, y)
res |> rep.Reply
else
printfn "#DIV/0"
return! loop()
else
return! loop()
}
loop()
)
// timeout = infinit => t = -1
let t = 1000
member inline this.Add(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Add (x, y, rep)), t)
|> Async.RunSynchronously
member inline this.Subtract(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Sub (x, y, rep)), t)
|> Async.RunSynchronously
member inline this.Multiply(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Mul (x, y, rep)), t)
|> Async.RunSynchronously
member inline this.Divide(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Div (x, y, rep)), t)
|> Async.RunSynchronously
As a use example, we have:
let calculatorAgentI = new CalculatorAgent<int>()
(2, 1) |> calculatorAgentI.Add
(2, 1) |> calculatorAgentI.Subtract
(2, 1) |> calculatorAgentI.Multiply
(2, 1) |> calculatorAgentI.Divide
(2, 0) |> calculatorAgentI.Divide
The issue is that Add and Multiply and the Last Divide work ok:
>
Adding 2 and 1 ...
val it : int option = Some 3
>
Multiplying 1 by 2 ...
val it : int option = Some 2
>
Dividing 2 by 0 ...
#DIV/0
val it : int option = None
As soon as we use Subtract and first Divide which would return int option = None, I get into trouble and the following is the only output I would get from any of the operations:
>
val it : int option = None
As long and hard as I think about it, I cannot figure out if there is a problem in the "subtract"/"divide" part or the "receive"/"reply" operations.
Running this code with the Debugger attached, you'll see that you get a System.NotSupportedException when trying to run the sub function from inside the agent:
System.NotSupportedException occurred
HResult=0x80131515
Message=Specified method is not supported.
Source=FSI-ASSEMBLY
StackTrace:
at FSI_0002.ops#60.FSI_0002-INumerics`1-Sub(T X1, T X2)
The reason you get val it : int option = None is because you have specified a 1-second timeout, and you are hitting that after the exception is thrown.
Calling the sub function directly works fine, but calling it through the CalculatorAgent class does not. This is because the type parameters are defined on the class in this case, and there are limitations on the use of structural type constraints on classes in F#. I would suggest reading up on Statically Resolved Type Parameters and their limitations.
The behaviour seems to be an irregularity or a bug. I was also expecting that this would behave the same for all operations.
In any case, you can workaround this by capturing ops in a static inline member (rather than using statically resolved type parameters on a type). The following works fine for me:
type CalculatorAgent<'T>(ops:INumerics<'T>) =
let agent =
Agent<CalculatorMsg<'T>>.Start(fun inbox ->
let rec loop () = async {
let! msg = inbox.TryReceive()
match msg with
| Some(Add (x, y, rep)) ->
printfn "Adding %A and %A ..." x y
let res = ops.Add(x, y)
res |> rep.Reply
return! loop()
| Some(Sub (x, y, rep)) ->
printfn "Subtracting %A from %A ..." y x
let res = ops.Sub(x, y)
res |> rep.Reply
return! loop()
| Some(Mul (x, y, rep)) ->
printfn "Multiplying %A by %A ... " y x
let res = ops.Mul(x, y)
res |> rep.Reply
return! loop()
| Some(Div (x, y, rep)) ->
printfn "Dividing %A by %A ..." x y
if ops.Neq(y, ops.Zer) then
let res = ops.Div(x, y)
res |> rep.Reply
else
printfn "#DIV/0"
return! loop()
| _ ->
return! loop() }
loop() )
// timeout = infinit => t = -1
let t = 1000
member this.Add(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Add (x, y, rep)), t)
|> Async.RunSynchronously
member this.Subtract(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Sub (x, y, rep)), t)
|> Async.RunSynchronously
member this.Multiply(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Mul (x, y, rep)), t)
|> Async.RunSynchronously
member this.Divide(x, y) =
agent.PostAndTryAsyncReply((fun rep -> Div (x, y, rep)), t)
|> Async.RunSynchronously
type CalculatorAgent =
static member inline Create() =
let ops =
{ new INumerics<_> with
member ops.Zer = LanguagePrimitives.GenericZero<_>
member ops.Add(x, y) = x + y
member ops.Sub(x, y) = x - y
member ops.Mul(x, y) = x * y
member ops.Div(x, y) = x / y
member ops.Neq(x, y) = x <> y }
CalculatorAgent<_>(ops)
let calculatorAgentI = CalculatorAgent.Create<int>()
(2, 1) |> calculatorAgentI.Add
(2, 1) |> calculatorAgentI.Subtract
(2, 1) |> calculatorAgentI.Multiply
(2, 1) |> calculatorAgentI.Divide
(2, 0) |> calculatorAgentI.Divide
That said, I think the cases where you really need generic numerical code are pretty rare - so I suspect it might be better to avoid introducing all this complexity altogether and just write the code for a specific numerical type.
Related
I have this scenario:
Write a function eval/2 that accepts as its first argument a tuple and second argument a map which maps atoms to numbers. For instance,the call eval({add, a, b}, #{a => 1, b => 2})return 3 and the call eval({mul, {add, a, 3}, b}, #{a => 1, b => 2}) return { ok, 8}2. More generally, eval(E, L) accepts as input an expression tuple E of three elements {Op, E1, E2} where Op is add, mul, ’div’ or sub and E1 and E2 is either a number, atom or an expression tuple, and an Erlang map L that acts as lookup table for atoms. The function returns either {ok, Value } or {error, Reason}, where Reason is either variable_not_found if an atom does not exist in the lookup table or unknown_error.
Implement the function eval/2 in the module task1 and export it.
example:
1> eval({add, 1, 2}, #{}).
{ok, 3}
2> eval({add, a, b}, #{a=>1}).
{error, variable_not_found}
3> eval({add, {add, a, b}, {add, 1, 2}}, #{a=>2, b=>3}). {ok, 8}
I solved the problem when only a tuple is sent but I don't really know how to handle the map that is sent to the function.
This is my code:
-module(task1).
-export([eval/1, eval/2]).
eval_inner({add, X, Y}) ->
eval_inner(X) + eval_inner(Y);
eval_inner({mul, X, Y}) ->
eval_inner(X) * eval_inner(Y);
eval_inner({'div', X, Y}) ->
eval_inner(X) / eval_inner(Y);
eval_inner({sub, X, Y}) ->
eval_inner(X) - eval_inner(Y);
eval_inner(X) when is_number(X) ->
X;
eval_inner(X) when is_atom(X) ->
maps:get(X, M).
eval(X) ->
try eval_inner(X) of
V -> {ok, V}
catch
_:_ -> error
end.
eval(X, M) ->
you have to pass the values map around.
-module(task1).
-export([eval/1, eval/2]).
eval_inner({add, X, Y}, M) ->
eval_inner(X, M) + eval_inner(Y, M);
eval_inner({mul, X, Y}, M) ->
eval_inner(X, M) * eval_inner(Y, M);
eval_inner({'div', X, Y}) ->
eval_inner(X, M) / eval_inner(Y, M);
eval_inner({sub, X, Y}) ->
eval_inner(X, M) - eval_inner(Y, M);
eval_inner(X, _M) when is_number(X) ->
X;
eval_inner(X, M) when is_atom(X) ->
maps:get(X, M).
eval(X, M) ->
try eval_inner(X, M) of
V -> {ok, V}
catch
_:_ -> error
end.
I am trying to implement a lazy fibonacci generator in Ocaml as shown below:
(* fib's helper *)
let rec fibhlpr n = if n == 0 then 0 else if n == 1 then 1 else fibhlpr (n-1) + fibhlpr (n-2);;
(* lazy fib? *)
let rec fib n = ((fibhlpr n), fun() -> fib (n+1));;
I am trying to return the result of fibhlpr (an int) and a function to retrieve the next value, but am not sure how. I think I have to create a new type in order to accommodate the two items I am returning, but I don't know what type fun() -> fib (n+1) returns. When messing around with the code, I received an error which informed me that
fun() -> fib (n+1) has type: int * (unit ->'a).
I am rather new to Ocaml and functional programming in general, so I don't know what this means. I tried creating a new type as follows:
type t = int * (unit -> 'a);;
However, I received the error: "Unbound type parameter 'a".
At this point I am truly stuck: how can I returns the two items that I want (the result of fibhlpr n and a function which returns the next value in the sequence) without causing an error? Thank you for any help.
If you want to define a lazy sequence, you can use the built-in sequence type
constructor Seq.t
let rec gen_fib a b () = Seq.Cons(a, gen_fib b (a+b))
let fib () = gen_fib 0 1 ()
This implementation also has the advantage that computing the n-th term of the sequence is O(n) rather than O(2^n).
If you want to keep using an infinite lazy type, it is also possible. However, you cannot use the recursive type expression
type t = int * (unit -> t)
without the -rectypes flag. And using -rectypes is generally ill-advised for beginners because it reduces the ability of type inference to identify programming errors.
It is thus better to simply use a recursive type definition as suggested by #G4143
type 'a infinite_sequence = { x:'a; next: unit -> 'a infinite_sequence }
let rec gen_fib a b () =
{ x = a; next = gen_fib b (a+b) }
let fib = gen_fib 0 1 ()
The correct type is
type t = int * (unit -> t)
You do not need a polymorphic 'a, because fibonacci only ever yields ints.
However, when you call the next function, you need to get the next value, but also a way to get the one after it, and so on and so on. You could call the function multiple times, but then it means that the function has mutable state, the above signature doesn't require that.
Try:
type 'a t = int * (unit -> 'a);
Your whole problems stems from this function:
let rec fib n = ((fibhlpr n), fun() -> fib (n+1))
I don't think the type system can define fib when it returns itself.. You need to create a new type which can construct a function to return.
I quickly tried this and it works:
type func = Func of (unit ->(int * func))
let rec fib n =
let c = ref 0 in
let rec f () =
if !c < n
then
(
c := !c + 1;
((fibhlpr !c), (Func f))
)
else
failwith "Done"
in
f
Following octachron's lead.. Here's a solution using Seq's unfold function.
let rec fibhlpr n =
if n == 0
then
0
else if n == 1
then
1
else
fibhlpr (n-1) + fibhlpr (n-2)
type func = Func of (unit -> (int * int * func))
let rec fib n =
(n, (fibhlpr n), Func(fun() -> fib (n+1)))
let seq =
fun x ->
Seq.unfold
(
fun e ->
let (c, d, Func f) = e in
if c > x
then
None
else
(
Some((c, d), f())
)
) (fib 0)
let () =
Seq.iter
(fun (c, d) -> Printf.printf "%d: %d\n" c d; (flush stdout)) (seq 30)
You started right saying your fib function returns an integer and a function:
type t = int * (unit -> 'a);;
But as the compiler says the 'a is not bound to anything. Your function also isn't polymorphic so that is has to return a type variable. The function you return is the fib function for the next number. Which also returns an integer and a function:
type t = int * (unit -> int * (unit -> 'a));;
But that second function again is the fib function for the next number.
type t = int * (unit -> int * (unit -> int * (unit -> 'a)))
And so on to infinity. Your type definition is actually recursive. The function you return as second half has the same type as the overall return type. You might try to write this as:
# type t = int * (unit -> t);;
Error: The type abbreviation t is cyclic
Recursive types are not allowed in ocaml unless the -rectypes option is used, which has some other side effects you should read about before using it.
A different way to break the cycle is to insert a Constructor into the cyclic type by making it a variant type:
# type t = Pair of int * (unit -> t)
let rec fibhlpr n = if n == 0 then 0 else if n == 1 then 1 else fibhlpr (n-1) + fibhlpr (n-2)
let rec fib n = Pair ((fibhlpr n), fun() -> fib (n+1));;
type t = Pair of int * (unit -> t)
val fibhlpr : int -> int = <fun>
val fib : int -> t = <fun>
Encapsulating the type recursion into a record type also works and might be the more common solution. Something like:
type t = { value : int; next : unit -> t; }
I also think you are missing the point of the exercise. Unless I'm mistaken the point of making it a generator is so that the function can compute the next fibonacci number from the two previous numbers, which you remember, instead of computing it recursively over and over.
The task is to get scalar value from 2 lists recursively. I wrote the code that I think should work, but I am having some type related problem
let rec scalar2 (a, b) = function
| ([], []) -> 0
| ([x : int], [y : int]) -> x * y
| (h1::t1, h2::t2) ->
let sc : int = scalar2 (t1,t2)
sc + (h1 * h2)
The error is that scalar2 (t1,t2) reqested to be int, but it is int list * int list -> int
How this problem could be solved?
When defining a function using the function keyword, you don't need to name your parameters (a and b here). Note that your function body doesn't refer to a or b at all. You want scalar2 to be a function, and the function expression on the right hand side results in a function, so just assign this function to scalar2 directly.
let rec scalar2 = function
| ([], []) -> 0
| ([x : int], [y : int]) -> x * y
| (h1::t1, h2::t2) ->
let sc : int = scalar2 (t1,t2)
sc + (h1 * h2)
Your mistake is likely caused by a confusion with the usual way of defining a function, which doesn't use the function keyword:
let rec scalar2 (a,b) =
match (a,b) with
| ([], []) -> 0
| ([x : int], [y : int]) -> x * y
| (h1::t1, h2::t2) ->
let sc : int = scalar2 (t1,t2)
sc + (h1 * h2)
This way you need a match expression which does use the parameters a and b.
Note that both of these definitions are incomplete, since you haven't said what should happen when only one of the lists is non-empty.
To explain the type error in the original code, consider how F# evaluates let sc : int = scalar2 (t1,t2). Your original definition says that scalar2 (a,b) = function ..., and the left-hand side of this equality has the same form as the expression scalar2 (t1,t2).
So the scalar2 (t1,t2) gets replaced with the function ... expression, after substituting t1 for a and t2 for b. This leaves let sc : int = function ... which of course doesn't type-check.
I have a question why does OCaml behaves somewhat unusual. By defining the function
let abs_diff x y = abs(x - y);;
we get val abs_diff : int -> int -> int = <fun> now by defining as
let abs_diff x y =
fun x -> (fun y -> abs(x - y));;
val abs_diff : 'a -> 'b -> int -> int -> int = <fun>
now using another function called as
let dist_from3 = abs_diff 3;;
with the first definition it works perfectly but with the second one it does not work as expected. We get that it is
val dist_from3 : '_a -> int -> int -> int = <fun>
why is it behaving like that, and why are those two definition of the at first look same function different?
In your second definition you have two distinct appearances (bindings) of x and y. That's why there are four parameters in the result. This is what you want:
let abs_diff = fun x -> fun y -> abs (x - y)
(FWIW in actual practice I sometimes make this mistake, especially when using the function keyword.)
Now I'm trying to prove a trivial array access procedure(file arr.c):
void set(int* arr, int key, int val)
{
arr[key] = val;
}
The file arr.c is translated to arr.v:
...
Definition f_set := {|
fn_return := tvoid;
fn_callconv := cc_default;
fn_params := ((_arr, (tptr tint)) :: (_key, tint) :: (_val, tint) :: nil);
fn_vars := nil;
fn_temps := nil;
fn_body :=
(Sassign
(Ederef
(Ebinop Oadd (Etempvar _arr (tptr tint)) (Etempvar _key tint)
(tptr tint)) tint) (Etempvar _val tint))
|}.
...
Here is the beginning of my proof (file verif_arr.v):
Require Import floyd.proofauto.
Require Import arr.
Local Open Scope logic.
Local Open Scope Z.
Inductive repr : Z -> val -> Prop :=
| mk_repr : forall z, z >= 0 -> z < Int.modulus -> repr z (Vint (Int.repr z)).
Function aPut (arr:Z -> val) (k:Z) (v:val) : Z -> val :=
fun (kk:Z) => if (Z.eq_dec k kk) then v else arr kk.
Definition set_spec :=
DECLARE _set
WITH sh : share, k : Z, arr : Z->val, vk : val, v : val, varr : val
PRE [_key OF tint, _val OF tint, _arr OF (tptr tint)]
PROP (0 <= k < 100; forall i, 0 <= i < 100 -> is_int (arr i);
writable_share sh; repr k vk)
LOCAL (`(eq vk) (eval_id _key);
`(eq varr) (eval_id _arr);
`(eq v) (eval_id _val);
`isptr (eval_id _arr))
SEP (`(array_at tint sh arr
0 100) (eval_id _arr))
POST [tvoid] `(array_at tint sh (aPut arr k v)
0 100 varr).
Definition Vprog : varspecs := nil.
Definition Gprog : funspecs := set_spec :: nil.
Lemma body_set: semax_body Vprog Gprog f_set set_spec.
Proof.
start_function.
name karg _key.
name arrarg _arr.
name valarg _val.
forward.
entailer!.
After the entailer!. tactic, I've got:
3 subgoals, subgoal 1 (ID 1261)
Espec : OracleKind
sh : share
k : Z
arr : Z -> val
H : 0 <= k < 100
H0 : forall i : Z, 0 <= i < 100 -> is_int (arr i)
H1 : writable_share sh
Delta := abbreviate : tycontext
MORE_COMMANDS := abbreviate : statement
Struct_env := abbreviate : type_id_env.type_id_env
karg : name _key
arrarg : name _arr
valarg : name _val
rho : environ
H2 : repr k (eval_id _key rho)
POSTCONDITION := abbreviate : ret_assert
H3 : isptr (eval_id _arr rho)
============================
offset_val (Int.repr (sizeof tint * 0)) (eval_id _arr rho) =
force_val (sem_add_pi tint (eval_id _arr rho) (eval_id _key rho))
subgoal 2 (ID 1266) is:
?890 = force_val (sem_cast_neutral (eval_id _val rho))
subgoal 3 (ID 1235) is:
semax Delta
(PROP ()
LOCAL (`(eq vk) (eval_id _key); `(eq varr) (eval_id _arr);
`(eq v) (eval_id _val); `isptr (eval_id _arr))
SEP (`(array_at tint sh (upd arr 0 ?890) 0 100) (eval_id _arr)))
(Sreturn None) POSTCONDITION
Now the questions:
In the specification set_spec there is a precondition '(array_at tint sh arr 0 100) (eval_id _arr) (here instead of ' should be backtick, which breaks the formatting). Why is this statement not present in the hypotheses list?
The first subgoal seems to me like it tryes to dereference 0 cell of the array (arr + 0), and it should be equal to a key-th cell (arr + key). That has nothing to do with the code or postcondition and certainly unprovable. What did go wrong here?
I use:
VST version:
Definition svn_rev := "6834P".
Definition release := "1.5".
Definition date := "2014-10-02".
CompCert version: 2.4
Coq version:
The Coq Proof Assistant, version 8.4pl3 (January 2014)
compiled on Jan 19 2014 23:14:16 with OCaml 4.01.0
Edit:
The last local ... part in the post condition turned out redundant.
First, the precondition '(array_at tint sh arr 0 100) (eval_id _arr) is actually present behind abbreviate in Delta hypothesis.
Second, it turned out, that entailer!. tactic is not safe, and can produce unprovable goals from eligible ones. In this case,
first I need to supply additional condition is_int v to be able to assign it to a cell of an "all ints" array. Seemingly VST can't deduce the type from CompCert annotations.
then instead of entailer!. I need to prove first all propositions on the right hand side separately, and then I can apply entailer to combine hypotheses.
Here are the correct spec, and proof:
Inductive repr : Z -> val -> Prop :=
| mk_repr : forall z, z >= 0 -> z < Int.modulus -> repr z (Vint (Int.repr z)).
Function aPut (arr:Z -> val) (k:Z) (v:val) : Z -> val :=
fun (kk:Z) => if (Z.eq_dec k kk) then v else arr kk.
Definition set_spec :=
DECLARE _set
WITH sh : share, k : Z, arr : Z->val, vk : val, v : val, varr : val
PRE [_key OF tint, _val OF tint, _arr OF (tptr tint)]
PROP (0 <= k < 100; forall i, 0 <= i < 100 -> is_int (arr i);
writable_share sh; repr k vk; is_int v)
LOCAL (`(eq vk) (eval_id _key);
`(eq varr) (eval_id _arr);
`(eq v) (eval_id _val);
`isptr (eval_id _arr))
SEP (`(array_at tint sh arr
0 100) (eval_id _arr))
POST [tvoid] `(array_at tint sh (aPut arr k v)
0 100 varr).
Definition Vprog : varspecs := nil.
Definition Gprog : funspecs := set_spec :: nil.
Lemma body_set: semax_body Vprog Gprog f_set set_spec.
Proof.
start_function.
name karg _key.
name arrarg _arr.
name valarg _val.
forward.
instantiate (1:=v).
instantiate (2:=k).
assert (offset_val (Int.repr (sizeof tint * k)) (eval_id _arr rho) =
force_val (sem_add_pi tint (eval_id _arr rho) (eval_id _key rho))).
inversion H2.
rewrite sem_add_pi_ptr.
unfold force_val.
apply f_equal2.
rewrite mul_repr.
auto.
auto.
assumption.
assert (eval_id _val rho = force_val (sem_cast_neutral (eval_id _val rho))).
apply is_int_e in H3.
destruct H3 as [n VtoN].
rewrite VtoN.
auto.
entailer.
forward.
Qed.