In my wrap.ml, I have a function as follows:
Js.Unsafe.global##.test := Js.wrap_callback (
fun params ->
print_endline "params##.a:";
print_endline (Js.to_string params##.a);
print_endline "params##.b:";
print_endline (Js.to_string params##.b);
Js.string ((Js.to_string params##.a) ^ (Js.to_string params##.b))
);
As a result, in a JavaScript file, I could call e.g., test({a: "abc", b:"efg"}).
I would like to know in the OCaml file, is there a way to check if the field b exists in the object params, before evaluating Js.to_string params##.b?
You can see how to do this at the bottom of this page:
https://ocsigen.org/js_of_ocaml/latest/manual/bindings
For this code:
let () =
if Js.Optdef.test ((Js.Unsafe.coerce Dom_html.document)##.URL) then
Printf.printf "document.URL exists\n"
else
Printf.printf "document.URL does not exist\n";
if Js.Optdef.test ((Js.Unsafe.coerce Dom_html.document)##.XXX) then
Printf.printf "document.XXX exists\n"
else
Printf.printf "document.XXX does not exist\n";
I see the following on the Javascript console:
document.URL exists
document.XXX does not exist
Related
I am trying to understand the following behaviour of OCaml Format module and semantic tags.
My code:
let prepare_ppf ppf =
let original_stag_functions = Format.pp_get_formatter_stag_functions ppf () in
let original_mark_tags_state = Format.pp_get_mark_tags ppf () in
Format.pp_set_mark_tags ppf true;
Format.pp_set_print_tags ppf false;
Format.pp_set_formatter_stag_functions ppf {
mark_open_stag = (fun stag ->
print_endline "MARK-OPEN";
match stag with
| Format.String_tag s -> Printf.sprintf "<open:%s>" s
| _ -> "<UNKNOWN>"
);
mark_close_stag = (fun stag ->
print_endline "MARK-CLOSE";
match stag with
| Format.String_tag s -> Printf.sprintf "</close:%s>" s
| _ -> "</UNKNOWN>"
);
print_open_stag = (fun _ -> print_endline "PRINT-OPEN"; ());
print_close_stag = (fun _ -> print_endline "PRINT-CLOSE"; ());
};
print_endline "PREPARED";
if Format.pp_get_mark_tags ppf () then print_endline "MARK:true";
(fun ppf ->
print_endline "RESET";
Format.pp_set_mark_tags ppf original_mark_tags_state;
Format.pp_set_formatter_stag_functions ppf original_stag_functions;)
let fprintf ppf fmt =
let reset = prepare_ppf ppf in
Format.kfprintf reset ppf fmt
let printf fmt = fprintf Format.std_formatter fmt
If I paste that into: utop version 2.8.0 (using OCaml version 4.12.0)
When I run it:
utop # printf "#{<bold>%s#}" "hello";;
PREPARED
MARK:true
RESET
<bold>hello</bold>- : unit = ()
Why are the mark_open_stag and close functions not called?
If I change line 5 to Format.pp_set_print_tags ppf true; then I see the print_open_stag and close function are called.
This is an interaction between buffering and utop handling of the stdout formatter.
The buffering issue can be seen with
printf "#{<bold>%s#}" "A very very very very very very very very very very very very very very very very very long hello world";;
which prints the half-correct
PREPARED
MARK:true
MARK-OPEN
<open:bold>A very very very very very very very very very very very very very very very very very long hello worldRESET
</bold>
Going on step further, flushing the stdout at the end with
printf "#{<bold>%s#}#." "hello";;
yields the correct output
PREPARED
MARK:true
MARK-OPEN
<open:bold>helloMARK-CLOSE
</close:bold>
RESET
The issue is thus that
printf "#{<bold>%s#}" "hello"
buffers completely all its input.
And it is utop taking the hand on the stdout formatter which triggers the printing by trying to print
- : unit = ()
This yields then
<bold>hello</bold>- : unit = ()
because at the time of the printing utop has reset the formatter configuration to its own default.
I am building a floating point calculator and I'm stuck. The fp calculator has prompt shape, so my problem is that where I handle the exceptions I leave the recursive function that keeps the prompt showing up and ends the execution:
let initialDictionary = ref EmptyDictionary;;
let launcher () =
print_string ("Welcome");
let rec aux dic =
try
print_string ("->");
aux ( execute dic (s token (Lexing.from_string (read_line () ))));
with
End_of_exec -> print_endline ("closing")
Var_not_assigned s -> printf "var %s not assigned" s
in aux !initialDictionary;;
Where:
val exec : dictionary -> Instruction -> dictionary;
type dictionary = (string,float)list
The point here is that as lists are immutable on ocaml, the only way I have to keep my dictionary stacking variables with its value is applying recursion taking the value dictionary from exec return.
So any ideas on how not to leave the "prompt like" execution while showing exceptions?
A read eval print loop interpreter has all these different phases which must be handled separately, and I think your implementation tried to do too much in a single step. Just breaking down the second part of your function will help untangle the different error handlers:
let launcher () =
let rec prompt dic =
print_string "->";
parse dic
and parse dic =
let res =
try
s token (Lexing.from_string ## read_line ())
with End_of_exec -> (print_encline "closing"; raise End_of_exec)
in evalloop dic res
and evalloop dic rep =
let dic =
try execute dic rep
with Var_not_assigned s -> (printf "var %s not assigned\n" s; dic)
in prompt dic
in prompt !InitialDictionary;;
Since each sub function will either tail call the next one or fail with an exception, the overall code should be tail recursive and optimised to a loop.
The good thing about this is that now you get a better picture of what is going on, and it makes it easier to change an individual step of the loop without touching the rest.
By the way, recall that read_line may trigger an End_of_file exception as well, but it should be trivial now to handle it now (left as an exercise).
Ok a friend of mine gave me a solution and thinking about it I cant figure out a more elegant way.
Let exec () =
Let _= print_string "->" in
( try
Let inst = s token (Lexing.from_string (read_line())) in
Try
Let r = exec_instruction !initialDictionary inst in
initialDictionary := r
With
| Var_not_assigned s -> printf "var %s not assigned. \n" s
| Com_not_implemented s -> printf " command %s not implemented. \n" s
| Function_not_implemented s -> printf " function %s not implemented. \n" s
With
| lexic_error -> print_endline "lexic error"
| Parsing. Parse_error -> print_endline "sintax error"
);;
Let rec program cont =
If cont then
Try
Exec (); program true
With
| End_of_exec -> print_endline "closing"; program false;;
Program true
The only thing that bothers me its the initialDictionary := r assignment, because exec_instruction returns a dictionary so it can be done recursive but it works anyways, ill figure out something hah.
Thank you for the help, if someone can see a brigther solution let me know.
The following code...
type 'a osResult =
Success of 'a
| Error of string
let errorCatcher f =
try
let result = f () in
Success result
with Unix.Unix_error (code, fun_name, arg) ->
Error(String.concat ":" [(Unix.error_message code); fun_name; arg])
let my_getcwd () =
errorCatcher (fun () -> Unix.getcwd ())
let _ =
print_endline "The Start";
let result = my_getcwd () |> function
| Success folder -> Printf.sprintf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.sprintf "getcwd (error):\n\t%s\n" errMessage
in
print_string result ;
print_endline "The End."
;;
...compiles fine:
$ corebuild -tag debug test1.native
...and runs fine:
$ ./test1.native
The Start
getcwd:
/home/ttsiod/work/byePythonHelloOCaml
The End.
But if I change the main body to this:
let _ =
print_endline "The Start";
my_getcwd () |> function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
;
print_endline "The End."
;;
... then apparently the last print statement ("The End") gets lost or something...
$ ./test2.native
The Start
getcwd:
/home/ttsiod/work/byePythonHelloOCaml
Initially, I thought this is a case of stdout buffering not being flushed.
But the docs of print_endline clearly claim that it flushes stdout, so I am at a loss - and adding "flush" didn't help, either:
let _ =
print_endline "The Start";
my_getcwd () |> function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
;
print_endline "The End." ;
flush stdout
;;
Help?
The print_endline is treated as part of the Error case. From the indentation, this is clearly not what you meant, but unfortunately the OCaml compiler doesn't warn about this.
You can use begin and end (or just parentheses) to make it work:
let () =
print_endline "The Start";
my_getcwd () |> begin function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
end;
print_endline "The End." ;
flush stdout
Alternatively, without using ;,
let () =
let () = print_endline "The Start" in
let () = match my_getcwd () with
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
in
let () = print_endline "The End." in
flush stdout
How to execute (in OCaml) the lines we get from fileinput described below?
let read_file filename =
let lines = ref [] in
let chan = open_in filename in
try
while true; do
lines := input_line chan :: !lines
done; []
with End_of_file ->
close_in chan;
List.rev !lines
It's not clear (to me) what you're asking. If you have a file containing some OCaml code, one way to run it is to load it into the toplevel. First, create a file named fileread.ml containing your text. Then (from the command line):
$ ocaml
OCaml version 4.01.0
# #use "fileread.ml";;
val read_file : string -> string list = <fun>
# read_file "fileread.ml";;
- : string list =
["let read_file filename ="; "let lines = ref [] in";
"let chan = open_in filename in"; "try"; "while true; do";
"lines := input_line chan :: !lines"; "done; []"; "with End_of_file ->";
"close_in chan;"; "List.rev !lines"]
If, instead, you're asking how an OCaml program can load text and execute it as OCaml code, this isn't something OCaml can do directly. Naturally there are ways to do it; the toplevel is after all an OCaml program. But there's no simple function in OCaml for executing text, as there is in many interpreted languages (often being named eval).
If, on the third hand, you're asking how to compile and run your code, add a line like this to the end of fileread.ml:
let () = List.iter print_endline (read_file "fileread.ml")
Then compile and run as follows:
$ ocamlc -o fileread fileread.ml
$ fileread
let read_file filename =
let lines = ref [] in
let chan = open_in filename in
try
while true; do
lines := input_line chan :: !lines
done; []
with End_of_file ->
close_in chan;
List.rev !lines
let () = List.iter print_endline (read_file "fileread.ml")
I have a problem where I have a global hashtable, and then I load a .cma file with Dynlink, which registers a function in the hashtable.
However, the behaviour I seem to be see is that when the module is dynamically linked, all the global bindings get re-initialised, such that my hashtable is empty.
E.g.:
Table.extensions : (string, string -> string) Hashtbl.t
Extensions.load : unit -> unit (* loads the specified .cma files *)
Extensions.register : string -> (string -> string) -> unit
(* adds entry to Table.extensions, prints name of extension registered *)
Main:
let () =
Extensions.load ();
Hashtbl.iter (fun x _ -> print_endline x) Table.extensions;
Printf.printf "%d extensions loaded\n" (Hashtbl.length Table.extensions)
My program loads one .cma file, so it should print:
Registered extension 'test'
test
1 extensions loaded
Instead I get:
Registered extension 'test'
0 extensions loaded
I've been fighting this for several hours now; no matter how I refactor my code, I get no closer to a working solution.
EDIT: Extensions.load:
Dynlink.allow_unsafe_modules true;;
let load () =
try
let exts = Sys.readdir "exts" in
Array.iter begin fun name ->
try
Dynlink.loadfile (Filename.concat "exts" name);
Printf.printf "Loaded %s\n" name;
with
| Dynlink.Error error -> print_endline (Dynlink.error_message error)
| exn -> print_endline (Printexc.to_string exn)
end exts
with _ -> ()
#ygrek, you were right, there were two instances.
The solution was to build/load just the .cmo, not a .cma.