(** Context free rewriting *)

open! Import

(** Local rewriting rules.

    This module lets you define local rewriting rules, such as extension point
    expanders. It is not completely generic and you cannot define any kind of rewriting,
    it currently focuses on what is commonly used. New scheme can be added on demand.

    We have some ideas to make this fully generic, but this hasn't been a priority so
    far.
*)
module Rule : sig
  type t

  (** Rewrite an extension point *)
  val extension : Extension.t -> t

  (** [special_function id expand] is a rule to rewrite a function call at parsing time.
      [id] is the identifier to match on and [expand] is used to expand the full function
      application (it gets the Pexp_apply node). If the function is found in the tree
      without being applied, [expand] gets only the identifier (Pexp_ident node) so you
      should handle both cases.

      If [id] is an operator identifier and contains dots, it should be parenthesized
      (e.g. ["(+.+)"]).

      [expand] must decide whether the expression it receive can be rewritten or not.
      Especially ppxlib makes the assumption that [expand] is idempotent. It will loop
      if it is not. *)
  val special_function
    :  string
    -> (expression -> expression option)
    -> t

  (** Used for the [constant] function. *)
  module Constant_kind : sig
    type t = Float | Integer
  end

  (** [constant kind suffix expander] Registers an extension for transforming constants
      literals, based on the suffix character. *)
  val constant
    :  Constant_kind.t
    -> char
    -> (Location.t -> string -> Parsetree.expression)
    -> t

  (** The rest of this API is for rewriting rules that apply when a certain attribute is
      present. The API is not complete and is currently only enough to implement
      deriving. *)

  (** Match the attribute on a group of items, such as a group of recursive type
      definitions (Pstr_type, Psig_type). The expander will be triggered if any of the
      item has the attribute. The expander is called as follow:

      [expand ~loc ~path rec_flag items values]

      where [values] is the list of values associated to the attribute for each item in
      [items]. [expand] must return a list of element to add after the group. For instance
      a list of structure item to add after a group of type definitions.
  *)
  type ('a, 'b, 'c) attr_group_inline =
    ('b, 'c) Attribute.t
    -> (ctxt:Expansion_context.Deriver.t
        -> Asttypes.rec_flag
        -> 'b list
        -> 'c option list
        -> 'a list)
    -> t

  val attr_str_type_decl : (structure_item, type_declaration, _) attr_group_inline
  val attr_sig_type_decl : (signature_item, type_declaration, _) attr_group_inline

  (** The _expect variants are for producing code that is compared to what the user wrote
      in the source code. *)
  val attr_str_type_decl_expect : (structure_item, type_declaration, _) attr_group_inline
  val attr_sig_type_decl_expect : (signature_item, type_declaration, _) attr_group_inline

  (** Same as [attr_group_inline] but for elements that are not part of a group, such as
      exceptions and type extensions *)
  type ('a, 'b, 'c) attr_inline =
    ('b, 'c) Attribute.t
    -> (ctxt:Expansion_context.Deriver.t
        -> 'b
        -> 'c
        -> 'a list)
    -> t

  val attr_str_module_type_decl : (structure_item, module_type_declaration, _) attr_inline
  val attr_sig_module_type_decl : (signature_item, module_type_declaration, _) attr_inline

  val attr_str_module_type_decl_expect : (structure_item, module_type_declaration, _) attr_inline
  val attr_sig_module_type_decl_expect : (signature_item, module_type_declaration, _) attr_inline

  val attr_str_type_ext : (structure_item, type_extension, _) attr_inline
  val attr_sig_type_ext : (signature_item, type_extension, _) attr_inline

  val attr_str_type_ext_expect : (structure_item, type_extension, _) attr_inline
  val attr_sig_type_ext_expect : (signature_item, type_extension, _) attr_inline

  val attr_str_exception : (structure_item, type_exception, _) attr_inline
  val attr_sig_exception : (signature_item, type_exception, _) attr_inline

  val attr_str_exception_expect : (structure_item, type_exception, _) attr_inline
  val attr_sig_exception_expect : (signature_item, type_exception, _) attr_inline
end

(**/**)
(*_ This API is not stable *)
module Generated_code_hook : sig
  type 'a single_or_many =
    | Single of 'a
    | Many   of 'a list

  (*_ Hook called whenever we generate code some *)
  type t =
    { f : 'a. 'a Extension.Context.t -> Location.t -> 'a single_or_many -> unit }

  val nop : t
end

module Expect_mismatch_handler : sig
  type t =
    { f : 'a. 'a Attribute.Floating.Context.t -> Location.t -> 'a list -> unit }

  val nop : t
end
(**/**)

(* TODO: a simple comment here is fine, while we would expect only docstring or (*_ *)
   comments to be accepted. On the contrary, docstrings are *not* accepted.

   This means https://github.com/ocaml/ocaml/pull/477 was not complete and indeed the
   parser should be fixed. *)
class map_top_down
  :  ?expect_mismatch_handler:Expect_mismatch_handler.t
    (* default: Expect_mismatch_handler.nop *)
    -> ?generated_code_hook:Generated_code_hook.t
    (* default: Generated_code_hook.nop *)
    -> Rule.t list
    -> Ast_traverse.map_with_expansion_context
