l4/pkg/ocaml/contrib/camlp4/Camlp4/Struct/Grammar/Entry.ml

   1 (****************************************************************************)
   2 (*                                                                          *)
   3 (*                              Objective Caml                              *)
   4 (*                                                                          *)
   5 (*                            INRIA Rocquencourt                            *)
   6 (*                                                                          *)
   7 (*  Copyright  2006   Institut National de Recherche  en  Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed under   *)
   9 (*  the terms of the GNU Library General Public License, with the special   *)
  10 (*  exception on linking described in LICENSE at the top of the Objective   *)
  11 (*  Caml source tree.                                                       *)
  12 (*                                                                          *)
  13 (****************************************************************************)
  14
  15 (* Authors:
  16  * - Daniel de Rauglaudre: initial version
  17  * - Nicolas Pouillard: refactoring
  18  *)
  19
  20 module Make (Structure : Structure.S) = struct
  21   module Dump  = Print.MakeDump Structure;
  22   module Print = Print.Make Structure;
  23   module Tools = Tools.Make Structure;
  24   open Format;
  25   open Structure;
  26
  27   type t 'a = internal_entry;
  28
  29   value name e = e.ename;
  30
  31   value print ppf e = fprintf ppf "%a@\n" Print.entry e;
  32   value dump ppf e = fprintf ppf "%a@\n" Dump.entry e;
  33
  34   (* value find e s = Find.entry e s; *)
  35
  36   value mk g n =
  37     { egram = g;
  38       ename = n;
  39       estart = Tools.empty_entry n;
  40       econtinue _ _ _ _ = parser [];
  41       edesc = Dlevels [] };
  42
  43   value action_parse entry ts : Action.t =
  44     Context.call_with_ctx ts
  45       (fun c ->
  46          try entry.estart 0 c (Context.stream c) with
  47          [ Stream.Failure ->
  48              Loc.raise (Context.loc_ep c)
  49                (Stream.Error ("illegal begin of " ^ entry.ename))
  50          | Loc.Exc_located _ _ as exc -> raise exc
  51          | exc -> Loc.raise (Context.loc_ep c) exc ]);
  52
  53   value lex entry loc cs = entry.egram.glexer loc cs;
  54
  55   value lex_string entry loc str = lex entry loc (Stream.of_string str);
  56
  57   value filter entry ts = Token.Filter.filter (get_filter entry.egram) ts;
  58
  59   value parse_tokens_after_filter entry ts = Action.get (action_parse entry ts);
  60
  61   value parse_tokens_before_filter entry ts = parse_tokens_after_filter entry (filter entry ts);
  62
  63   value parse entry loc cs = parse_tokens_before_filter entry (lex entry loc cs);
  64
  65   value parse_string entry loc str =
  66     parse_tokens_before_filter entry (lex_string entry loc str);
  67
  68   value of_parser g n (p : Stream.t (Token.t * Loc.t) -> 'a) : t 'a =
  69     { egram = g;
  70       ename = n;
  71       estart _ _ ts = Action.mk (p ts);
  72       econtinue _ _ _ _ = parser [];
  73       edesc = Dparser (fun ts -> Action.mk (p ts)) };
  74
  75   value setup_parser e (p : Stream.t (Token.t * Loc.t) -> 'a) =
  76     let f ts = Action.mk (p ts) in do {
  77       e.estart := fun _ _ -> f;
  78       e.econtinue := fun _ _ _ _ -> parser [];
  79       e.edesc := Dparser f
  80     };
  81
  82   value clear e =
  83     do {
  84       e.estart := fun _ _ -> parser [];
  85       e.econtinue := fun _ _ _ _ -> parser [];
  86       e.edesc := Dlevels []
  87     };
  88
  89   value obj x = x;
  90
  91 end;