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.
Related
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
I'm following Real World OCaml to get started with the language, and, at one point, I am to make use of s-expressions in a module signature. Here's my mli file:
open Core.Std
(** Configuration type for query handlers *)
type config with sexp
(** Name of the query handler *)
val name : string
(** Query handler abstract type *)
type t
(** Create a query handler from an existing [config] *)
val create : config -> t
(** Evaluate a query, where both input and output an s-expressions. *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
But, when compiling an implementation of that interface, I get the following error:
File "Query_Handler.mli", line 4, characters 12-16:
Error: Syntax error
Command exited with code 2.
So I opened utop to try with sexp on a simpler example:
module type Test = sig
type t with sexp
end;;
But I get the following error:
Error: Parse Error: "end" expected after [sig_items] (in [module type])
However, sexplib is installed and neither the book nor my searches on the Internet mention any "prerequisites" for using this syntax.
I feel like I'm missing something. Any idea? :(
This is because the sexp library had been rewritten to use Extension Point, instead of Camlp4.
open Core.Std
module type Query_handler = sig
(** Configuration for a query handler. Note that this can be
Converted to and from an s-expression *)
type config [##deriving sexp]
(** The name of the query-handling service *)
val name : string
(** The state of the query handler *)
type t
(** Create a new query handler from a config *)
val create : config -> t
(** Evaluate a given query, where both input and output are
s-expressions *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
end
module Unique = struct
type config = int [##deriving sexp]
type t = { mutable next_id: int }
let name = "unique"
let create start_at = { next_id = start_at }
let eval t sexp =
match Or_error.try_with (fun () -> unit_of_sexp sexp) with
| Error _ as err -> err
| Ok () ->
let response = Ok (Int.sexp_of_t t.next_id) in
t.next_id <- t.next_id + 1;
response
end
module List_dir = struct
type config = string [##deriving sexp]
type t = { cwd: string }
(** [is_abs p] Returns true if [p] is an absolute path *)
let is_abs p =
String.length p > 0 && p.[0] = '/'
let name = "ls"
let create cwd = { cwd }
let eval t sexp =
match Or_error.try_with (fun () -> string_of_sexp sexp) with
| Error _ as err -> err
| Ok dir ->
let dir =
if is_abs dir then dir
else Filename.concat t.cwd dir
in
Ok (Array.sexp_of_t String.sexp_of_t (Sys.readdir dir))
end
module type Query_handler_instance = sig
module Query_handler : Query_handler
val this : Query_handler.t
end
let build_instance (type a)
(module Q : Query_handler with type config = a)
config =
(module struct
module Query_handler = Q
let this = Q.create config
end : Query_handler_instance)
let build_dispatch_table handlers =
let table = String.Table.create () in
List.iter handlers
~f:(fun ((module I : Query_handler_instance) as instance) ->
Hashtbl.replace table ~key:I.Query_handler.name ~data:instance);
table
let dispatch dispatch_table name_and_query =
match name_and_query with
| Sexp.List [Sexp.Atom name; query] ->
begin match Hashtbl.find dispatch_table name with
| None ->
Or_error.error "Could not find matching handler"
name String.sexp_of_t
| Some (module I : Query_handler_instance) ->
I.Query_handler.eval I.this query
end
| _ ->
Or_error.error_string "malformed query"
let rec cli dispatch_table =
printf ">>> %!";
let result =
match In_channel.input_line stdin with
| None -> `Stop
| Some line ->
match Or_error.try_with (fun () -> Sexp.of_string line) with
| Error e -> `Continue (Error.to_string_hum e)
| Ok query ->
begin match dispatch dispatch_table query with
| Error e -> `Continue (Error.to_string_hum e)
| Ok s -> `Continue (Sexp.to_string_hum s)
end;
in
match result with
| `Stop -> ()
| `Continue msg ->
printf "%s\n%!" msg;
cli dispatch_table
let unique_instance = build_instance (module Unique) 0
let list_dir_instance = build_instance (module List_dir) "/var"
module Loader = struct
type config = (module Query_handler) list sexp_opaque [##deriving sexp]
type t = { known : (module Query_handler) String.Table.t
; active : (module Query_handler_instance) String.Table.t
}
let name ="loader"
let create known_list =
let active = String.Table.create () in
let known = String.Table.create () in
List.iter known_list
~f:(fun ((module Q : Query_handler) as q) ->
Hashtbl.replace known ~key:Q.name ~data:q);
{ known; active }
let load t handler_name config =
if Hashtbl.mem t.active handler_name then
Or_error.error "Can't re-register an active handler"
handler_name String.sexp_of_t
else
match Hashtbl.find t.known handler_name with
| None ->
Or_error.error "Unknown handler" handler_name String.sexp_of_t
| Some (module Q : Query_handler) ->
let instance =
(module struct
module Query_handler = Q
let this = Q.create (Q.config_of_sexp config)
end : Query_handler_instance)
in
Hashtbl.replace t.active ~key:handler_name ~data:instance;
Ok Sexp.unit
let unload t handler_name =
if not (Hashtbl.mem t.active handler_name) then
Or_error.error "Handler not active" handler_name String.sexp_of_t
else if handler_name = name then
Or_error.error_string "It's unwise to unload yourself"
else (
Hashtbl.remove t.active handler_name;
Ok Sexp.unit
)
type request =
| Load of string * Sexp.t
| Unload of string
| Known_services
| Active_services [##deriving sexp]
let eval t sexp =
match Or_error.try_with (fun () -> request_of_sexp sexp) with
| Error _ as err -> err
| Ok resp ->
match resp with
| Load (name,config) -> load t name config
| Unload name -> unload t name
| Known_services ->
Ok [%sexp ((Hashtbl.keys t.known ) : string list)]
| Active_services ->
Ok [%sexp ((Hashtbl.keys t.active) : string list)]
end
This is my ~/.ocamlinit; just comment out the camlp4. utop should work happy.
#use "topfind";;
#warnings "+9"
#thread;;
(*camlp4;;*)
#require "core.top";;
#require "core_extended";;
#require "core_bench";;
#require "ppx_jane";;
#require "ctypes";;
#require "ctypes.foreign";;
Taken from the chapter 18 of the Real World OCaml book, I'm trying to break down the example given.
My scope, to just make the GET call and print something of the JSON we get back.
This is my code ( it's supposed to be a subset of the example given )
(* libraries *)
open Core.Std
open Async.Std
(* Generate a DuckDuckGo search URI from a query string *)
let query_uri query =
let base_uri = Uri.of_string "http://api.duckduckgo.com/?format=json" in
Uri.add_query_param base_uri ("q", [query])
(* Extract the "Definition" or "Abstract" field from the DuckDuckGo results *)
let get_definition_from_json json_string =
match Yojson.Safe.from_string json_string with
| `Assoc kv_list ->
let find key =
begin match List.Assoc.find kv_list key with
| None | Some (`String "") -> None
| Some s -> Some (Yojson.Safe.to_string s)
end
in
begin match find "Abstract" with
| Some _ as x -> x
| None -> find "Definition"
end
| _ -> None
(* Execute the DuckDuckGo search *)
let get_definition word =
print_endline ("get_definition word:" ^ word);
Cohttp_async.Client.get (query_uri word)
>>= fun (_, body) ->
Pipe.to_list (Cohttp_async.Body.to_pipe body)
>>| fun strings ->
(word, get_definition_from_json (String.concat strings))
(* run *)
let () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
My issue is that I get this error when compiling:
ocaml setup.ml -build
Finished, 0 targets (0 cached) in 00:00:00.
+ /Users/antouank/.opam/system/bin/ocamlfind ocamlc -c -g -annot -bin-annot -thread -package yojson -package threads -package textwrap -package re2 -package core -package cohttp.async -I src -o src/main.cmo src/main.ml
File "src/main.ml", line 48, characters 18-41:
Error: This expression has type unit but an expression was expected of type
'a Async.Std.Deferred.t = 'a Async_kernel.Deferred0.t
Command exited with code 2.
Compilation unsuccessful after building 2 targets (0 cached) in 00:00:00.
E: Failure("Command ''/usr/local/bin/ocamlbuild' src/main.native -use-ocamlfind -tag debug' terminated with error code 10")
make: *** [build] Error 1
How can I get the string out of that Deferred, and what does that error mean exactly?
In the book, the example is run with a weird Command wrap, so I cannot see how to pull it out.
The problem in your definition of run is that the anonymous function
fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
is not correctly typed to be used with a monadic operator >>=. It has type string * string -> unit while the >>= would here expect a function of type string * string -> unit Deferred.t.
If you look at the example of an echo server in the very same chapter, it will suggest the following approach:
let run () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
);
Deferred.return()
let () =
ignore(run ());
never_returns (Scheduler.go ())
I'm trying to use the CIL library to parse C source code. I'm searching for a particular function using its name.
let cil_func = Caml.List.find (fun g ->
match g with
| GFun(f,_) when (equal f.svar.vname func) -> true
| _ -> false
) cil_file.globals in
let body g = match g with GFun(f,_) -> f.sbody in
dumpBlock defaultCilPrinter stdout 1 (body cil_func)
So I have a type GFun of fundec * location, and I'm trying to get the sbody attribute of fundec.
It seems redundant to do a second pattern match, not to mention, the compiler complains that it's not exhaustive. Is there a better way of doing this?
You can define your own function that returns just the fundec:
let rec find_fundec fname = function
| [] -> raise Not_found
| GFun (f, _) :: _ when equal (f.svar.vname fname) -> f (* ? *)
| _ :: t -> find_fundec fname t
Then your code looks more like this:
let cil_fundec = find_fundec func cil_file.globals in
dumpBlock defaultCilPrinter stdout 1 cil_fundec.sbody
For what it's worth, the line marked (* ? *) looks wrong to me. I don't see why f.svar.vname would be a function. I'm just copying your code there.
Update
Fixed an error (one I often make), sorry.
I'm really new to OCaml, and wanted to try and do some work with pcap as a way of getting started, only, there doesn't seem to be a maintained library for it. After looking at the awesome Real World OCaml book, I figured I'd give writing a binding a go.
Here's the (poor) code snippet:
open Ctypes
open Foreign
open PosixTypes
let char_ptr = " "
let pcap_lookupdev = foreign "pcap_lookupdev" (string #-> returning string_opt)
let result = pcap_lookupdev char_ptr
let test2 =
match result with
| None -> char_ptr
| Some str -> str
;;
print_string test2;;
The pcap_lookupdev function returns either a string containing the device name or a null pointer. That bit seems to work fine (although I know my code is hardly idiomatic).
When writing this in C, you need to provide a character array to hold any error messages. So if a null pointer is returned, you should fail with the reason held in this character array. This character array should be "PCAP_ERRBUF_SIZE" long. However I can't figure out two things:
How to pull that constant size from the C library and create a string that size
Pass the string correctly to the function so that it gets correctly populated with the error message
Any help most gratefully appreciated :)
For 1) the easiest way for getting #ifdef'd symbols into OCaml is to write a C program that outputs a seperate module with the value of these symbol. You then just use this module in your bindings when you need the symbols. You can find an example of this approach here.
For 2) I'd say ctypes's string is a little bit deceptive as it doesn't seem to act in a bidirectional fashion, that is you should only use it for const char * or return types. In this case you need to use arrays of character and then translate it to a string (this char_array_as_string function should be added to ctypes I think). Here's the full example, note that in future versions of ctypes the Array module will change its name to CArray:
(* Compile with: ocamlfind ocamlopt -package ctypes.foreign -linkpkg -cclib -lpcap \
-o test.native test.ml *)
open Ctypes;;
open Foreign;;
module Pcap : sig
val lookupdev : unit -> [ `Ok of string | `Error of string ]
end = struct
let errbuf_size = 256 (* N.B. This should not be hardcoded, see 1) above *)
let char_array_as_string a =
let len = Array.length a in
let b = Buffer.create len in
try
for i = 0 to len -1 do
let c = Array.get a i in
if c = '\x00' then raise Exit else Buffer.add_char b c
done;
Buffer.contents b
with Exit -> Buffer.contents b
let lookupdev =
foreign "pcap_lookupdev" (ptr char #-> returning string_opt)
let lookupdev () =
let err = Array.make char ~initial:'\x00' errbuf_size in
match lookupdev (Array.start err) with
| None -> `Error (char_array_as_string err)
| Some dev -> `Ok dev
end
let test () = match Pcap.lookupdev () with
| `Ok dev -> Printf.printf "dev: %s\n" dev
| `Error err -> Printf.printf "error: %s\n" err
let () = test ()