I am trying to implement a recursively calling function in SML. My code is
CM.make "$cml/cml.cm";
open CML;
fun sender n()= if (n<100)
then
(
TextIO.print (Int.toString(n)^"\n");
sender n+1
)
else
exit ()
fun main () = let
val _ = spawn (sender 3);
val tid1 = getTid();
in
TextIO.print("MY TID" ^ (tidToString tid1)^"\n")
end;
RunCML.doit(main, NONE);
I am getting the below error
Cml.sml:3.5-10.8 Error: right-hand-side of clause doesn't agree with function result type [circularity]
expression: unit -> 'Z
result type: 'Z
in declaration:
sender = (fn arg => (fn <pat> => <exp>))
What am I doing wrong?
Your function sender starts with
fun sender n()= ...
which gives it the type
sender : int -> unit -> 'a
as you need for your definition in main. However, when you later call it recursively, you call it as
sender n+1
Now, even if you write this as
sender (n+1)
to get the correct precedences, you still get the type unit -> 'a whereas you want the type 'a. So all you need to do is to pass an extra () : unit to it, and your sender function will typecheck:
fun sender n () =
if (n<100)
then (
TextIO.print (Int.toString(n)^"\n");
sender n+1 ())
else exit ()
Related
I am attempting to implement a basic 'stress testing' program in MLton and its Concurrent ML implementation, specifically the Monte Carlo Pi test described here. While I think I have most of what I need figured out, I have a problem in that my program always terminates before the CML threads have finished their work. I know that they are doing something, since I sometimes see them print text to the console that I have directed should be printed, but there seems to be a race condition between them getting started and running, and the program as a whole exiting.
The code where I start CML is:
local
val iterations : int = 10
val num_threads : int = 1
val still_going : bool ref = ref true
in
val _ = (RunCML.doit ((experiment iterations num_threads still_going), NONE);
(* while !still_going do (); (* Spin-wait for the CML stuff to finish. This doesn't work... *) *)
print "All done!\n")
end
the contents of the experiment function are:
fun experiment (iterations : int) (num_threads : int) (still_going : bool ref) () : unit = let
val iters_per_thread : int = iterations div num_threads
val return_ivars = Vector.tabulate (num_threads, (fn _ => SyncVar.iVar()))
val _ = Vector.map (fn return_ivar => CML.spawn (montecarlopi iters_per_thread return_ivar)) return_ivars
val return_val = Vector.foldl (fn (elem, acc) => acc + (SyncVar.iGet elem)) 0.0 return_ivars
in
(TextIO.print ("Result is: " ^ (Real.toString return_val) ^ "\n");
still_going := false)
end
and finally, the montecarlopi function is:
fun montecarlopi (iterations : int) (return_ivar : real SyncVar.ivar) () = let
val _ = MLton.Random.srand (valOf (MLton.Random.useed ()))
fun helper accumulator 0 = accumulator
| helper accumulator iteration = let
val x : real = wordToBoundedReal (MLton.Random.rand ())
val y : real = wordToBoundedReal (MLton.Random.rand ())
val in_target = (x * x) + (y * y)
val next_iter = iteration - 1
val _ = TextIO.print ("next_iter is: " ^ (Int.toString next_iter) ^ ", in_target is: " ^ (Real.toString in_target) ^ ",x is: " ^ (Real.toString x) ^ ",y is: " ^ (Real.toString y) ^ "\n")
in
if in_target < 1.0 then
helper (accumulator + 1) next_iter
else
helper accumulator next_iter
end
in
SyncVar.iPut (return_ivar, (4.0 * ((real (helper 0 iterations)) / (real iterations))))
end
(The full (small) program and accompanying .mlb file can be viewed here). I'm reasonably sure that the bits inside the RunCML.doit function call do what they're supposed to, which leads me to think that the issue is probably to do with the outermost part of the program.
As you can see, I tried to spin wait, using a ref cell on a boolean to determine when to stop, but that doesn't seem to work. Nor does trying to spin wait using RunCML.isRunning - although both of those sound like terrible ideas to begin with, really, anyway. Of course, I can't use something like a CML channel or syncvar, since those need to be inside the RunCML.doit segment to be used. Changing the number of threads doesn't make any difference to this problem. Nor was I able to find any other functions that would make the main part go into a non-blocking wait.
How do I get the outer part of my program to wait until the bulk of it, inside the RunCML.doit function call, completes? Or, am I doing something wrong inside that part, which is causing the problem?
If we look at the the function RunCML.doit, It has type OS.Process.status which can either be success or failure, from which your call to doit is returning failure. There is a CML function shutdown: OS.Process.status -> 'a.
Which could be an explaination for why it's failing, except you don't call shutdown, and parts of your output results never print.
Here is a small example exercising various mechanisms for CML's shutdown, where CML seems to be doing something such as 'graceful' internally. Catching exceptions raised and turning those into failure.
structure Main = struct
open CML
structure RunCML = RunCML;
exception ohno
fun raises() = raise ohno
fun succeed() = RunCML.shutdown(OS.Process.success)
fun fail() = RunCML.shutdown(OS.Process.failure)
fun graceful f () =
let val () = f() handle _ => RunCML.shutdown(OS.Process.failure);
in RunCML.shutdown(OS.Process.success)
end
fun print_status status =
if OS.Process.isSuccess status
then TextIO.print("success\n")
else TextIO.print("failure\n")
fun main() = let
val _ = TextIO.print(banner ^ "\n");
val _ = print_status(RunCML.doit(succeed, NONE))
val _ = print_status(RunCML.doit(fail, NONE))
val _ = print_status(RunCML.doit(raises, NONE))
val _ = print_status(RunCML.doit(graceful(raises), NONE))
val _ = print_status(RunCML.doit(graceful(succeed), NONE))
in OS.Process.success end
end
So, if CML is exiting strangely, and you aren't calling shutdown yourself, its a good chance there is an exception being raised somewhere, which turned out to be the case.
One way to avoid this silent handling of exceptions might in the future might be adding something like:
fun noisy f () =
let val () = f()
handle e =>
let val () = TextIO.print ("Exception: " ^ (exnName e)
^ " Message: " ^ (exnMessage e) ^ "\n")
in RunCML.shutdown(OS.Process.failure) end
in RunCML.shutdown(OS.Process.success)
end
then calling RunCML.doit(noisy(f), NONE)
P.S. Thank you for including a link to your code, it would have been much harder to understand the problem otherwise.
I'm writing code to monitor the content of a file. When the program reaches the end of the the file I want it to terminate cleanly.
let log () : input_channel Lwt.t =
openfile "log" [O_RDONLY] 0 >>= fun fd ->
Lwt.return (of_fd input fd);;
let rec loop (ic: input_channel) = Lwt_io.read_line ic >>= fun text ->
Lwt_io.printl text >>= fun _ -> loop ic;;
let monitor () : unit Lwt.t = log () >>= loop;;
let handler : exn -> unit Lwt.t = fun e -> match e with
| End_of_file -> let (p: unit Lwt.t), r = Lwt.wait() in p
| x -> Lwt.fail x;;
let main () : unit Lwt.t = Lwt.catch monitor handler;;
let _ = Lwt_main.run (main ());;
However, when reading a file and reaching the end, the program does not terminate, it just hangs and I have to escape with Ctrl+c. I am not sure what is going on under the hood with bind but I figured whatever it's doing, eventually Lwt_io.readline ic should eventually hit the end of the file and return an End_of_file exception, which presumably would get passed over to the handler, etc.
If I had to guess at a resolution, I would think maybe in the last bind of the definition of >>= I would include some if check. But I'd be checking, I think, whether Lwt_io.read_line returned End_of_file, which I though should be handled by the handler.
The Lwt.wait function creates a promise which could only be resolved using the second element of the returned pair, basically, this function will never terminate:
let never_ready () =
let (p,_) = Lwt.wait in
p
and this is exactly what you've written.
Concerning a graceful termination, ideally, you should do this in the loop function so that you can close the channel and prevent leaking of the valuable resources, e.g.,
let rec loop (ic: input_channel) =
Lwt_io.read_line ic >>= function
| exception End_of_file ->
Lwt.close ic
| text->
Lwt_io.printl text >>= fun () ->
loop ic
The minimum change to your code would be, however, to use Lwt.return () instead of Lwt.wait in the body of your handler.
I want to write a function prefix_action with seq (resp suffix_action), here is the code in BatEnum :
let prefix_action f t =
let full_action e =
e.count <- (fun () -> t.count());
e.next <- (fun () -> t.next ());
e.clone <- (fun () -> t.clone());
f ()
in
let rec t' =
{
count = (fun () -> full_action t'; t.count() );
next = (fun () -> full_action t'; t.next() );
clone = (fun () -> full_action t'; t.clone() );
fast = t.fast
} in t'
I want to know as we don't have clone in sequences, i want to know how i should considerate clone in these case (is it a use of the sequence) and if that's the case how can we have the number of times that the sequence is used?
Prefix_action Documentation
The sequence as it is defined don't have clone function just because it is "defined by default".
type 'a node =
| Nil
| Cons of 'a * 'a t
and 'a t = unit -> 'a node
As you can see it's just a function returning some sum type, simple value if you wish, there is no side effects (in fact they can be hiden in the body of the function, but for now let me trick you). Thus the clone function in this case is just an identity:
let clone s = s
Now if you look at the definition of enumeration you will notice little mutable keyword:
type 'a t = {
mutable count : unit -> int;
mutable next : unit -> 'a;
mutable clone : unit -> 'a t;
mutable fast : bool;
}
If we try to use same clone as for sequences, we will notice that the changes of one copy will affect the other:
# let e1 = { fast = true; (* ... *) };;
val e1 : 'a t = {fast = true; (* ... *)}
# let e2 = clone e1;;
val e2 : 'a t = {fast = true; (* ... *)}
# e1.fast <- false;;
- : unit = ()
# e2;;
'a t = {fast = false; (* ... *)}
That's why they need clone function.
So now you can implement your functions, for example prefix_action.
prefix_action f e will behave as e but guarantees that f () will be
invoked exactly once before the current first element of e is read.
The problem is in this "exactly once". I'm not sure what does it means, but let say that this means that if you pass sequence to prefix_action f and then two times to hd, then f will be executed only once (because if it means something different it's not interesting). And now we can return to this "side effects" story. Clearly, we can't implement prefix_action without them. The type of sequence doesn't contain any mutable keyword, but it contains functions! Hence, we can wrap our side effect into the function.
let prefix_action : (unit -> unit) -> 'a t -> 'a t = fun f s ->
let b = ref true in
fun () -> (if !b then f (); b := false); s ()
But now, as we have side effects, we need redefine clone. From the specification of prefix_action:
If prefix_action f e is cloned, f is invoked only once, during the
cloning.
Hence our clone:
let clone s = let _ = s (); s
I have this function that results a string list:
fun get_substitutions1 ([],_) = []
| get_substitutions1 (x::xs,s) = case all_except_option(s,x) of
NONE => [] #get_substitutions1(xs,s)
| SOME lst => lst #get_substitutions1(xs,s)
And this function that takes a string list list and a type:
fun similar_names(slist,full_name:{first:string,middle:string,last:string})=
let
fun aux(slist,acc)=
case full_name of
{first=a,middle=b,last=c} => case get_substitutions1(slist,a) of
[] => full_name::acc
| x::xs' => full_name:: aux(xs',{first=x,middle=b,last=c}::acc)
in aux(slist,[])
end
And i get an error:
Error: operator and operand don't agree.
operator domain: string list list *
{first:string, last:string, middle:string} list
operand: string list *
{first:string, last:string, middle:string} list
in expression:
aux (xs',{first=x,middle=b,last=c} :: acc)
Is there any other way?
Well first of all you might wan't to indent your code so that it is readable.
It is quite obvious why you get the error you do. The function
fun get_substitutions1 ([],_) = []
| get_substitutions1 (x::xs,s) =
case all_except_option(s,x) of
NONE => []#get_substitutions1(xs,s)
| SOME lst => lst #get_substitutions1(xs,s)
has the type
val get_substitutions1 = fn : ''a list list * ''a -> ''a list
and you are trying to use the result of this function in your inner case expression where you take the tail of the returned list (type 'a list) and use them in the recursive function call.
fun similar_names(slist,full_name:{first:string,middle:string,last:string})=
let
fun aux(slist,acc)=
case full_name of
{first=a,middle=b,last=c} =>
case get_substitutions1(slist,a) of
[] => full_name::acc
| x::xs' => full_name:: aux(xs',{first=x,middle=b,last=c}::acc)
in aux(slist,[])
end
However since your first argument of aux is used in get_substitutions1, that argument must be of type 'a list list, but the xs' you use down in the recursive call is only of type 'a list.
I was going through some notes and I realized something is amiss.
When emulating lazy computation (without open Lazy;) one can do the following for a stream of ones.
datatype 'a susp = Susp of (unit -> 'a)
datatype 'a stream' = Cons of 'a * ('a stream') susp
type 'a stream = ('a stream') susp
fun delay (f ) = Susp(f);
fun force (Susp(f)) = f ();
val rec ones' = fn () => Cons(1, delay(ones'));
val ones = delay(ones')
fun ltail(Susp(s)) = ltail'(force s)
and ltail' (Cons(x,s)) = s
But for getting a suspended tail the types do not match up.
operator domain: 'Z susp
operand: unit -> 'Y
What will need to change for the proper types for ltail ?
I know what happens with a tail not suspended.
I just want to figure out what the notes were saying for the suspended version.
fun ltail(Susp(s)) = ltail'(force s)
The problem here is that force takes a value of type susp, but you call it with a value of type () -> 'a. I.e. you take the function out of the susp value and then call force on the function instead of the susp value. You should just do:
fun ltail s = ltail' (force s)