ocaml - 无法使用 s 表达式

Question

我关注 Real World OCaml开始使用该语言，并且在某一时刻，我将在模块签名中使用 s 表达式。这是我的mli文件:

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

但是，在编译该接口(interface)的实现时，我收到以下错误:

File "Query_Handler.mli", line 4, characters 12-16:
Error: Syntax error
Command exited with code 2.

于是我打开了 utop试试 with sexp在一个更简单的例子中:

module type Test = sig
  type t with sexp
end;;

但我收到以下错误:

Error: Parse Error: "end" expected after [sig_items] (in [module type])

但是， sexplib已安装，本书和我在 Internet 上的搜索均未提及使用此语法的任何“先决条件”。

我觉得我错过了什么。任何的想法？ :(

Answer 1

这是因为sexp 库已被重写为使用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