open Camlp4;                                             (* -*- camlp4r -*- *)

(****************************************************************************)

(*                                                                          *)

(*                                   OCaml                                  *)

(*                                                                          *)

(*                            INRIA Rocquencourt                            *)

(*                                                                          *)

(*  Copyright  2007  Institut  National  de  Recherche en Informatique et   *)

(*  en Automatique.  All rights reserved.  This file is distributed under   *)

(*  the terms of the GNU Library General Public License, with the special   *)

(*  exception on linking described in LICENSE at the top of the Camlp4      *)

(*  source tree.                                                            *)

(*                                                                          *)

(****************************************************************************)

(* Authors:

 * - Nicolas Pouillard: Original version

 *)

module Id = struct

  value name = "Camlp4Reloaded";

  value version = Sys.ocaml_version;

end;

module Make (Syntax : Sig.Camlp4Syntax) = struct

  open Sig;

  include Syntax;

  Gram.Entry.clear match_case;

  Gram.Entry.clear semi;

  value mkseq _loc =

    fun

    [ <:expr< $_$; $_$ >> as e -> <:expr< do { $e$ } >>

    | e -> e ]

  ;

  DELETE_RULE Gram match_case0: patt_as_patt_opt; opt_when_expr; "->"; expr END;

  value revised =

    try

      (DELETE_RULE Gram expr: "if"; SELF; "then"; SELF; "else"; SELF END; True)

    with [ Struct.Grammar.Delete.Rule_not_found _ -> begin

      DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top"; "else"; expr LEVEL "top" END;

      DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top" END; False

    end ];

  if revised then begin

    DELETE_RULE Gram expr: "fun"; "["; LIST0 match_case0 SEP "|"; "]" END;

    EXTEND Gram

      expr: LEVEL "top"

      [ [ "function"; a = match_case -> <:expr< fun [ $a$ ] >> ] ];

    END;

    DELETE_RULE Gram value_let: "value" END;

    DELETE_RULE Gram value_val: "value" END;

  end else begin

    DELETE_RULE Gram value_let: "let" END;

    DELETE_RULE Gram value_val: "val" END;

  end;

  EXTEND Gram

    GLOBAL: match_case match_case0 expr value_let value_val semi;

    match_case:

      [ [ OPT "|"; l = LIST1 match_case0 SEP "|"; "end" -> Ast.mcOr_of_list l

        | "end" -> <:match_case<>> ] ]

    ;

    match_case0:

      [ [ p = patt_as_patt_opt; w = opt_when_expr; "->"; e = sequence ->

            <:match_case< $p$ when $w$ -> $mkseq _loc e$ >> ] ]

    ;

    expr: LEVEL "top"

      [ [ "if"; e1 = sequence; "then"; e2 = sequence; "else"; e3 = sequence; "end" ->

            <:expr< if $mkseq _loc e1$ then $mkseq _loc e2$ else $mkseq _loc e3$ >>

        | "if"; e1 = sequence; "then"; e2 = sequence; "end" ->

            <:expr< if $mkseq _loc e1$ then $mkseq _loc e2$ else () >> ] ]

    ;

    value_let:

      [ [ "val" -> () ] ]

    ;

    value_val:

      [ [ "val" -> () ] ]

    ;

    semi:

      [ [ ";;" -> () | ";" -> () | -> () ] ]

    ;

  END;

end;

let module M = Register.OCamlSyntaxExtension Id Make in ();