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