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

   1 (* camlp4r *)
   2 (****************************************************************************)
   3 (*                                                                          *)
   4 (*                              Objective Caml                              *)
   5 (*                                                                          *)
   6 (*                            INRIA Rocquencourt                            *)
   7 (*                                                                          *)
   8 (*  Copyright  2006   Institut National de Recherche  en  Informatique et   *)
   9 (*  en Automatique.  All rights reserved.  This file is distributed under   *)
  10 (*  the terms of the GNU Library General Public License, with the special   *)
  11 (*  exception on linking described in LICENSE at the top of the Objective   *)
  12 (*  Caml source tree.                                                       *)
  13 (*                                                                          *)
  14 (****************************************************************************)
  15
  16
  17
  18 (* Authors:
  19  * - Daniel de Rauglaudre: initial version
  20  * - Nicolas Pouillard: refactoring
  21  *)
  22 module Make (Structure : Structure.S) = struct
  23   open Structure;
  24   open Format;
  25   module Parse = Parser.Make Structure;
  26   module Fail = Failed.Make Structure;
  27   open Sig.Grammar;
  28
  29   module Stream = struct
  30     include Stream;
  31     value junk strm = Context.junk strm;
  32     value count strm = Context.bp strm;
  33   end;
  34
  35   value sfold0 f e _entry _symbl psymb =
  36     let rec fold accu =
  37       parser
  38       [ [: a = psymb; s :] -> fold (f a accu) s
  39       | [: :] -> accu ]
  40     in
  41     parser [: a = fold e :] -> a
  42   ;
  43
  44   value sfold1 f e _entry _symbl psymb =
  45     let rec fold accu =
  46       parser
  47       [ [: a = psymb; s :] -> fold (f a accu) s
  48       | [: :] -> accu ]
  49     in
  50     parser [: a = psymb; a = fold (f a e) :] -> a
  51   ;
  52
  53   value sfold0sep f e entry symbl psymb psep =
  54     let failed =
  55       fun
  56       [ [symb; sep] -> Fail.symb_failed_txt entry sep symb
  57       | _ -> "failed" ]
  58     in
  59     let rec kont accu =
  60       parser
  61       [ [: () = psep; a = psymb ?? failed symbl; s :] -> kont (f a accu) s
  62       | [: :] -> accu ]
  63     in
  64     parser
  65     [ [: a = psymb; s :] -> kont (f a e) s
  66     | [: :] -> e ]
  67   ;
  68
  69   value sfold1sep f e entry symbl psymb psep =
  70     let failed =
  71       fun
  72       [ [symb; sep] -> Fail.symb_failed_txt entry sep symb
  73       | _ -> "failed" ]
  74     in
  75     let parse_top =
  76       fun
  77       [ [symb; _] -> Parse.parse_top_symb entry symb (* FIXME context *)
  78       | _ -> raise Stream.Failure ]
  79     in
  80     let rec kont accu =
  81       parser
  82       [ [: () = psep;
  83           a =
  84             parser
  85             [ [: a = psymb :] -> a
  86             | [: a = parse_top symbl :] -> Obj.magic a
  87             | [: :] -> raise (Stream.Error (failed symbl)) ];
  88           s :] ->
  89             kont (f a accu) s
  90       | [: :] -> accu ]
  91     in
  92     parser [: a = psymb; s :] -> kont (f a e) s
  93   ;
  94 end;