diff options
| -rw-r--r-- | camlp4/Camlp4/OCamlInitSyntax.ml | 1 | ||||
| -rw-r--r-- | camlp4/Camlp4/Printers/OCaml.ml | 5 | ||||
| -rw-r--r-- | camlp4/Camlp4/Sig/Camlp4Syntax.mli | 1 | ||||
| -rw-r--r-- | camlp4/Camlp4/Sig/Grammar/Dynamic.mli | 4 | ||||
| -rw-r--r-- | camlp4/Camlp4/Sig/Grammar/Static.mli | 4 | ||||
| -rw-r--r-- | camlp4/Camlp4/Sig/Grammar/Structure.mli | 9 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Dynamic.ml | 5 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Failed.ml | 2 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Fold.ml | 94 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Fold.mli | 30 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Parser.ml | 13 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Static.ml | 5 | ||||
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Structure.ml | 19 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/Grammar.ml | 39 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/OCaml.ml | 17 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/OCamlr.ml | 14 | ||||
| -rw-r--r-- | camlp4/Camlp4Printers/Null.ml | 33 | ||||
| -rw-r--r-- | camlp4/Camlp4Printers/OCaml.ml | 2 | ||||
| -rw-r--r-- | camlp4/Makefile.ml | 12 | ||||
| -rw-r--r-- | camlp4/unmaintained/extfold/extfold.ml | 91 | ||||
| -rw-r--r-- | camlp4/unmaintained/extfold/extfold.mli | 24 |
21 files changed, 281 insertions, 143 deletions
diff --git a/camlp4/Camlp4/OCamlInitSyntax.ml b/camlp4/Camlp4/OCamlInitSyntax.ml index 9031ad0e2..252105129 100644 --- a/camlp4/Camlp4/OCamlInitSyntax.ml +++ b/camlp4/Camlp4/OCamlInitSyntax.ml @@ -52,6 +52,7 @@ module Make (Warning : Sig.Warning.S) value amp_ctyp = Gram.Entry.mk "amp_ctyp"; value and_ctyp = Gram.Entry.mk "and_ctyp"; value assoc = Gram.Entry.mk "assoc"; + value assoc0 = Gram.Entry.mk "assoc0"; value binding = Gram.Entry.mk "binding"; value class_declaration = Gram.Entry.mk "class_declaration"; value class_description = Gram.Entry.mk "class_description"; diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml index 74d7b5810..b94cf57ff 100644 --- a/camlp4/Camlp4/Printers/OCaml.ml +++ b/camlp4/Camlp4/Printers/OCaml.ml @@ -682,6 +682,8 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct | <:ctyp< +'$s$ >> -> pp f "+'%a" o#var s | <:ctyp< -'$s$ >> -> pp f "-'%a" o#var s | <:ctyp< $t1$ | $t2$ >> -> pp f "%a@ | %a" o#ctyp t1 o#ctyp t2 + | <:ctyp< $t1$ : mutable $t2$ >> -> + pp f "@[mutable@ %a :@ %a@]" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ : $t2$ >> -> pp f "@[<2>%a :@ %a@]" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$; $t2$ >> -> pp f "%a;@ %a" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ of $t2$ >> -> @@ -718,10 +720,9 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct [ <:ctyp@loc< $t1$ and $t2$ >> -> let () = o#node f t (fun _ -> loc) in pp f "%a@ * %a" o#constructor_type t1 o#constructor_type t2 + | <:ctyp< $_$ -> $_$ >> -> pp f "(%a)" o#ctyp t | t -> o#ctyp f t ]; - (* <:ctyp< $lid:s$ : mutable $t$ >> -> pp f "@[mutable@ %a :@ %a@]" o#var s o#ctyp t *) - (* | <:ctyp< $lid:s$ : $t$ >> -> pp f "@[%a%a :@ %a@]" o#var s o#ctyp t *) method sig_item f sg = let () = o#node f sg Ast.loc_of_sig_item in diff --git a/camlp4/Camlp4/Sig/Camlp4Syntax.mli b/camlp4/Camlp4/Sig/Camlp4Syntax.mli index 49e0b84f7..bec156369 100644 --- a/camlp4/Camlp4/Sig/Camlp4Syntax.mli +++ b/camlp4/Camlp4/Sig/Camlp4Syntax.mli @@ -55,6 +55,7 @@ module type S = sig value amp_ctyp : Gram.Entry.t Ast.ctyp; value and_ctyp : Gram.Entry.t Ast.ctyp; value assoc : Gram.Entry.t Ast.assoc; + value assoc0 : Gram.Entry.t Ast.assoc; value assoc_quot : Gram.Entry.t Ast.assoc; value binding : Gram.Entry.t Ast.binding; value binding_quot : Gram.Entry.t Ast.binding; diff --git a/camlp4/Camlp4/Sig/Grammar/Dynamic.mli b/camlp4/Camlp4/Sig/Grammar/Dynamic.mli index 58264e5b3..fb685ece6 100644 --- a/camlp4/Camlp4/Sig/Grammar/Dynamic.mli +++ b/camlp4/Camlp4/Sig/Grammar/Dynamic.mli @@ -68,6 +68,10 @@ module type S = sig value delete_rule : Entry.t 'a -> delete_statment -> unit; value srules : Entry.t 'a -> list (list symbol * Action.t) -> symbol; + value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; + (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) (** Use the lexer to produce a non filtered token stream from a char stream. *) value lex : gram -> Loc.t -> Stream.t char diff --git a/camlp4/Camlp4/Sig/Grammar/Static.mli b/camlp4/Camlp4/Sig/Grammar/Static.mli index 6778c2d3d..e33e1b4e4 100644 --- a/camlp4/Camlp4/Sig/Grammar/Static.mli +++ b/camlp4/Camlp4/Sig/Grammar/Static.mli @@ -64,6 +64,10 @@ module type S = sig (** The delete rule. *) value delete_rule : Entry.t 'a -> delete_statment -> unit; value srules : Entry.t 'a -> list (list symbol * Action.t) -> symbol; + value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; + (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) (** Use the lexer to produce a non filtered token stream from a char stream. *) value lex : Loc.t -> Stream.t char diff --git a/camlp4/Camlp4/Sig/Grammar/Structure.mli b/camlp4/Camlp4/Sig/Grammar/Structure.mli index 7d8fc3261..9cd7489ec 100644 --- a/camlp4/Camlp4/Sig/Grammar/Structure.mli +++ b/camlp4/Camlp4/Sig/Grammar/Structure.mli @@ -62,4 +62,13 @@ module type S = sig type extend_statment = (option position * list single_extend_statment); type delete_statment = list symbol; + + type fold 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; + + type foldsep 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; + end; diff --git a/camlp4/Camlp4/Struct/Grammar/Dynamic.ml b/camlp4/Camlp4/Struct/Grammar/Dynamic.ml index 875f78813..f024325b2 100644 --- a/camlp4/Camlp4/Struct/Grammar/Dynamic.ml +++ b/camlp4/Camlp4/Struct/Grammar/Dynamic.ml @@ -24,6 +24,7 @@ module Make (Lexer : Sig.Lexer.S) module Delete = Delete.Make Structure; module Insert = Insert.Make Structure; module Entry = Entry.Make Structure; + module Fold = Fold.Make Structure; include Structure; value mk () = @@ -62,6 +63,10 @@ module Make (Lexer : Sig.Lexer.S) DeadEnd rl in Stree t; + value sfold0 = Fold.sfold0; + value sfold1 = Fold.sfold1; + value sfold0sep = Fold.sfold0sep; + (* value sfold1sep = Fold.sfold1sep; *) value extend = Insert.extend; end; diff --git a/camlp4/Camlp4/Struct/Grammar/Failed.ml b/camlp4/Camlp4/Struct/Grammar/Failed.ml index d10f35a44..2fecbb514 100644 --- a/camlp4/Camlp4/Struct/Grammar/Failed.ml +++ b/camlp4/Camlp4/Struct/Grammar/Failed.ml @@ -128,4 +128,6 @@ value symb_failed entry prev_symb_result prev_symb symb = tree_failed entry prev_symb_result prev_symb tree ; +value symb_failed_txt e s1 s2 = symb_failed e 0 s1 s2; + end; diff --git a/camlp4/Camlp4/Struct/Grammar/Fold.ml b/camlp4/Camlp4/Struct/Grammar/Fold.ml new file mode 100644 index 000000000..4d8c44c82 --- /dev/null +++ b/camlp4/Camlp4/Struct/Grammar/Fold.ml @@ -0,0 +1,94 @@ +(* camlp4r *) +(****************************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 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 Objective *) +(* Caml source tree. *) +(* *) +(****************************************************************************) + +(* $Id$ *) + +(* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) +module Make (Structure : Structure.S) = struct + open Structure; + open Format; + module Parse = Parser.Make Structure; + module Fail = Failed.Make Structure; + open Sig.Grammar.Structure; + + module Stream = struct + include Stream; + value junk strm = Context.junk strm; + value count strm = Context.bp strm; + end; + + value sfold0 f e _entry _symbl psymb = + let rec fold accu = + parser + [ [: a = psymb; s :] -> fold (f a accu) s + | [: :] -> accu ] + in + parser [: a = fold e :] -> a + ; + + value sfold1 f e _entry _symbl psymb = + let rec fold accu = + parser + [ [: a = psymb; s :] -> fold (f a accu) s + | [: :] -> accu ] + in + parser [: a = psymb; a = fold (f a e) :] -> a + ; + + value sfold0sep f e entry symbl psymb psep = + let failed = + fun + [ [symb; sep] -> Fail.symb_failed_txt entry sep symb + | _ -> "failed" ] + in + let rec kont accu = + parser + [ [: () = psep; a = psymb ?? failed symbl; s :] -> kont (f a accu) s + | [: :] -> accu ] + in + parser + [ [: a = psymb; s :] -> kont (f a e) s + | [: :] -> e ] + ; + + value sfold1sep f e entry symbl psymb psep = + let failed = + fun + [ [symb; sep] -> Fail.symb_failed_txt entry sep symb + | _ -> "failed" ] + in + let parse_top = + fun + [ [symb; _] -> Parse.parse_top_symb entry symb (* FIXME context *) + | _ -> raise Stream.Failure ] + in + let rec kont accu = + parser + [ [: () = psep; + a = + parser + [ [: a = psymb :] -> a + | [: a = parse_top symbl :] -> Obj.magic a + | [: :] -> raise (Stream.Error (failed symbl)) ]; + s :] -> + kont (f a accu) s + | [: :] -> accu ] + in + parser [: a = psymb; s :] -> kont (f a e) s + ; +end; diff --git a/camlp4/Camlp4/Struct/Grammar/Fold.mli b/camlp4/Camlp4/Struct/Grammar/Fold.mli new file mode 100644 index 000000000..f2f4f8745 --- /dev/null +++ b/camlp4/Camlp4/Struct/Grammar/Fold.mli @@ -0,0 +1,30 @@ +(* camlp4r *) +(****************************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 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 Objective *) +(* Caml source tree. *) +(* *) +(****************************************************************************) + +(* $Id$ *) + +(* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + +module Make (Structure : Structure.S) : sig + open Structure; + + value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; + value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; + (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) +end; diff --git a/camlp4/Camlp4/Struct/Grammar/Parser.ml b/camlp4/Camlp4/Struct/Grammar/Parser.ml index 2d5e01d9b..5231610a7 100644 --- a/camlp4/Camlp4/Struct/Grammar/Parser.ml +++ b/camlp4/Camlp4/Struct/Grammar/Parser.ml @@ -206,13 +206,12 @@ module Make (Structure : Structure.S) = struct | _ -> invalid_arg "parser_of_token_list" ] and parser_of_symbol entry nlevn c = fun - [ Smeta _ _symbl _act -> - failwith "FIXME" - (* let act = (magic "parser_of_symbol: act" act : 'a -> 'b -> 'c) entry symbl in *) - (* Action.mk *) - (* (List.fold_left *) - (* (fun act symb -> magic "parser_of_symbol: act2" act (parser_of_symbol entry nlevn c symb)) *) - (* act symbl) *) + [ Smeta _ symbl act -> + let act = Obj.magic act entry symbl in + Obj.magic + (List.fold_left + (fun act symb -> Obj.magic act (parser_of_symbol entry nlevn c symb)) + act symbl) | Slist0 s -> let ps = parser_of_symbol entry nlevn c s in let rec loop al = diff --git a/camlp4/Camlp4/Struct/Grammar/Static.ml b/camlp4/Camlp4/Struct/Grammar/Static.ml index 64eb472e5..60651a47c 100644 --- a/camlp4/Camlp4/Struct/Grammar/Static.ml +++ b/camlp4/Camlp4/Struct/Grammar/Static.ml @@ -23,6 +23,7 @@ module Make (Lexer : Sig.Lexer.S) module Structure = Structure.Make Lexer; module Delete = Delete.Make Structure; module Insert = Insert.Make Structure; + module Fold = Fold.Make Structure; include Structure; value gram = @@ -73,6 +74,10 @@ module Make (Lexer : Sig.Lexer.S) DeadEnd rl in Stree t; + value sfold0 = Fold.sfold0; + value sfold1 = Fold.sfold1; + value sfold0sep = Fold.sfold0sep; + (* value sfold1sep = Fold.sfold1sep; *) value extend = Insert.extend; diff --git a/camlp4/Camlp4/Struct/Grammar/Structure.ml b/camlp4/Camlp4/Struct/Grammar/Structure.ml index 957060fc6..278da4079 100644 --- a/camlp4/Camlp4/Struct/Grammar/Structure.ml +++ b/camlp4/Camlp4/Struct/Grammar/Structure.ml @@ -81,6 +81,14 @@ module type S = sig (option position * list single_extend_statment); type delete_statment = list symbol; + type fold 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; + + type foldsep 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; + (* Accessors *) value get_filter : gram -> Token.Filter.t; @@ -157,6 +165,15 @@ module Make (Lexer : Sig.Lexer.S) = struct type extend_statment = (option position * list single_extend_statment); type delete_statment = list symbol; + + type fold 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; + + type foldsep 'a 'b 'c = + internal_entry -> list symbol -> + (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; + value get_filter g = g.gfilter; type not_filtered 'a = 'a; @@ -248,8 +265,6 @@ value is_level_labelled n lev = | None -> False ] ; -value symb_failed_txt e s1 s2 = symb_failed e 0 s1 s2; - value tokens g con = let list = ref [] in do { diff --git a/camlp4/Camlp4Parsers/Grammar.ml b/camlp4/Camlp4Parsers/Grammar.ml index 1251869a2..0cb240921 100644 --- a/camlp4/Camlp4Parsers/Grammar.ml +++ b/camlp4/Camlp4Parsers/Grammar.ml @@ -322,7 +322,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct tl <:expr< [] >> in <:expr< - $uid:gm$.Smeta $str:n$ $el$ (Obj.repr ($make_ctyp_expr t tvar e$)) >> + $uid:gm$.Smeta $str:n$ $el$ ($uid:gm$.Action.mk ($make_ctyp_expr t tvar e$)) >> | TXlist _loc min t ts -> let txt = make_expr entry "" t.text in match (min, ts) with @@ -826,6 +826,43 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct ; END; + value sfold _loc n foldfun f e s = + let styp = STquo _loc (new_type_var ()) in + let e = <:expr< $uid:gm$.$lid:foldfun$ $f$ $e$ >> in + let t = STapp _loc (STapp _loc (STtyp <:ctyp< $uid:gm$.fold _ >>) s.styp) styp in + {used = s.used; text = TXmeta _loc n [s.text] e t; styp = styp; pattern = None } + ; + + value sfoldsep _loc n foldfun f e s sep = + let styp = STquo _loc (new_type_var ()) in + let e = <:expr< $uid:gm$.$lid:foldfun$ $f$ $e$ >> in + let t = + STapp _loc (STapp _loc (STtyp <:ctyp< $uid:gm$.foldsep _ >>) s.styp) styp + in + {used = s.used @ sep.used; text = TXmeta _loc n [s.text; sep.text] e t; + styp = styp; pattern = None} + ; + + EXTEND Gram + GLOBAL: symbol; + symbol: LEVEL "top" + [ [ UIDENT "FOLD0"; f = simple_expr; e = simple_expr; s = SELF -> + sfold _loc "FOLD0" "sfold0" f e s + | UIDENT "FOLD1"; f = simple_expr; e = simple_expr; s = SELF -> + sfold _loc "FOLD1" "sfold1" f e s + | UIDENT "FOLD0"; f = simple_expr; e = simple_expr; s = SELF; + UIDENT "SEP"; sep = symbol -> + sfoldsep _loc "FOLD0 SEP" "sfold0sep" f e s sep + | UIDENT "FOLD1"; f = simple_expr; e = simple_expr; s = SELF; + UIDENT "SEP"; sep = symbol -> + sfoldsep _loc "FOLD1 SEP" "sfold1sep" f e s sep ] ] + ; + simple_expr: + [ [ i = a_LIDENT -> <:expr< $lid:i$ >> + | "("; e = expr; ")" -> e ] ] + ; + END; + Options.add "-split_ext" (Arg.Set split_ext) "Split EXTEND by functions to turn around a PowerPC problem."; diff --git a/camlp4/Camlp4Parsers/OCaml.ml b/camlp4/Camlp4Parsers/OCaml.ml index d38ba6032..0767a3ec6 100644 --- a/camlp4/Camlp4Parsers/OCaml.ml +++ b/camlp4/Camlp4Parsers/OCaml.ml @@ -252,7 +252,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct | None -> raise Stream.Failure ] in match Stream.peek strm with - [ Some ((KEYWORD "[" | (LIDENT _ | UIDENT _)), _) -> skip_simple_ctyp 1 + [ Some ((KEYWORD "[" | LIDENT _ | UIDENT _), _) -> skip_simple_ctyp 1 | Some (KEYWORD "object", _) -> raise Stream.Failure | _ -> 1 ]) ; @@ -369,19 +369,19 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct clear sem_expr; clear label_declaration; clear star_ctyp; + clear assoc; DELETE_RULE Gram value_let: "value" END; DELETE_RULE Gram value_val: "value" END; DELETE_RULE Gram str_item: value_let; opt_rec; binding END; DELETE_RULE Gram module_type: "'"; a_ident END; - DELETE_RULE Gram assoc: END; DELETE_RULE Gram label_expr: label_longident; fun_binding END; EXTEND Gram GLOBAL: a_CHAR a_FLOAT a_INT a_INT32 a_INT64 a_LABEL a_LIDENT a_LIDENT_or_operator a_NATIVEINT a_OPTLABEL a_STRING a_UIDENT a_ident - amp_ctyp and_ctyp assoc assoc_quot binding binding_quot + amp_ctyp and_ctyp assoc assoc0 assoc_quot binding binding_quot class_declaration class_description class_expr class_expr_quot class_fun_binding class_fun_def class_info_for_class_expr class_info_for_class_type class_longident class_longident_and_param @@ -593,6 +593,9 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct <:ident< $uid:i$.$lid:j$ >> | i = a_UIDENT; "."; j = SELF -> <:ident< $uid:i$.$j$ >> ] ] ; + assoc: + [ [ l = LIST1 assoc0 SEP "|" -> Ast.asOr_of_list l ] ] + ; (* Patterns *) patt: [ "as" LEFTA @@ -689,6 +692,14 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct class_type_plus: [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >> + | "~"; i = a_LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> + | i = LABEL (* FIXME inlie a_LABEL *); t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> + | "?"; i = a_LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | i = OPTLABEL (* FIXME inline a_OPTLABEL *); t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> | ct = class_type -> ct ] ] ; class_type_longident_and_param: diff --git a/camlp4/Camlp4Parsers/OCamlr.ml b/camlp4/Camlp4Parsers/OCamlr.ml index c92b44d5d..1a41200dd 100644 --- a/camlp4/Camlp4Parsers/OCamlr.ml +++ b/camlp4/Camlp4Parsers/OCamlr.ml @@ -65,6 +65,7 @@ Old (no more supported) syntax: Gram.Entry.clear amp_ctyp; Gram.Entry.clear and_ctyp; Gram.Entry.clear assoc; + Gram.Entry.clear assoc0; Gram.Entry.clear assoc_quot; Gram.Entry.clear binding; Gram.Entry.clear binding_quot; @@ -317,7 +318,7 @@ Old (no more supported) syntax: GLOBAL: a_CHAR a_FLOAT a_INT a_INT32 a_INT64 a_LABEL a_LIDENT a_LIDENT_or_operator a_NATIVEINT a_OPTLABEL a_STRING a_UIDENT a_ident - amp_ctyp and_ctyp assoc assoc_quot binding binding_quot + amp_ctyp and_ctyp assoc assoc0 assoc_quot binding binding_quot class_declaration class_description class_expr class_expr_quot class_fun_binding class_fun_def class_info_for_class_expr class_info_for_class_type class_longident class_longident_and_param @@ -653,8 +654,10 @@ Old (no more supported) syntax: | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] ; assoc: - [ [ a1 = SELF; "|"; a2 = SELF -> <:assoc< $a1$ | $a2$ >> - | `ANTIQUOT ("assoc"|"list" as n) s -> + [ [ l = LIST0 assoc0 SEP "|" -> Ast.asOr_of_list l ] ] + ; + assoc0: + [ [ `ANTIQUOT ("assoc"|"list" as n) s -> <:assoc< $anti:mk_anti ~c:"assoc" n s$ >> | `ANTIQUOT (""|"anti" as n) s -> <:assoc< $anti:mk_anti ~c:"assoc" n s$ >> @@ -663,7 +666,6 @@ Old (no more supported) syntax: | `ANTIQUOT (""|"anti" as n) s; "when"; w = expr; "->"; e = expr -> <:assoc< $anti:mk_anti ~c:"patt" n s$ when $w$ -> $e$ >> | p = patt_as_patt_opt; w = opt_when_expr; "->"; e = expr -> <:assoc< $p$ when $w$ -> $e$ >> - | -> <:assoc<>> ] ] ; opt_when_expr: @@ -907,9 +909,7 @@ Old (no more supported) syntax: ] ] ; constructor_declarations: - [ [ t1 = SELF; "|"; t2 = SELF -> <:ctyp< $t1$ | $t2$ >> - | t = constructor_declaration -> t - ] ] + [ [ l = LIST1 constructor_declaration SEP "|" -> Ast.tyOr_of_list l ] ] ; constructor_declaration: [ [ `ANTIQUOT (""|"typ" as n) s -> diff --git a/camlp4/Camlp4Printers/Null.ml b/camlp4/Camlp4Printers/Null.ml new file mode 100644 index 000000000..ed5582a57 --- /dev/null +++ b/camlp4/Camlp4Printers/Null.ml @@ -0,0 +1,33 @@ +(****************************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 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 Objective *) +(* Caml source tree. *) +(* *) +(****************************************************************************) + +(* Authors: + * - Nicolas Pouillard: initial version + *) + +open Camlp4; + +module Id = struct + value name = "Camlp4Printers.Null"; + value version = "$Id$"; +end; + +module Make (Syntax : Sig.Syntax.S) = struct + include Syntax; + + value print_interf ?input_file:(_) ?output_file:(_) _ = (); + value print_implem ?input_file:(_) ?output_file:(_) _ = (); +end; + +let module M = Register.Printer Id Make in (); diff --git a/camlp4/Camlp4Printers/OCaml.ml b/camlp4/Camlp4Printers/OCaml.ml index 6111be28a..312f4a460 100644 --- a/camlp4/Camlp4Printers/OCaml.ml +++ b/camlp4/Camlp4Printers/OCaml.ml @@ -16,4 +16,4 @@ * - Nicolas Pouillard: initial version *) -(* Camlp4.Printers.OCaml.enable (); *) +Camlp4.Printers.OCaml.enable (); diff --git a/camlp4/Makefile.ml b/camlp4/Makefile.ml index 38a41176a..95af4434f 100644 --- a/camlp4/Makefile.ml +++ b/camlp4/Makefile.ml @@ -157,6 +157,7 @@ let camlp4_package = ocaml_IModule ~impl_flags:"-rectypes" "Print"; ocaml_Module "Failed"; ocaml_Module "Parser"; + ocaml_IModule "Fold"; ocaml_Module "Insert"; ocaml_Module "Delete"; ocaml_Module "Entry"; @@ -205,6 +206,7 @@ let camlp4_printers = ocaml_Module "DumpCamlp4Ast"; ocaml_Module "OCaml"; ocaml_Module "OCamlr"; + ocaml_Module "Null"; ]) let camlp4_filters = @@ -344,22 +346,22 @@ let try_cp src dest = if Sys.file_exists src then cp src dest let doc () = let revised_to_ocaml f = - run ["./camlp4boot.run pr_o.cmo -o "^f^".ml -impl "^f^".ml4"] in + run ["./camlp4boot.run -printer OCaml -o "^f^".ml -impl "^f^".ml4"] in let ocamldoc title fl = run (("cd doc && ../../ocamldoc/ocamldoc -html -I ../../parsing "^ - "-I ../build -I ../../utils -I .. -dump ocamldoc.out -t '"^title^"'") :: fl) in + "-I ../build -I ../../utils -I .. -rectypes -dump ocamldoc.out -t '"^title^"'") :: fl) in let ppf_of_file f = formatter_of_out_channel (open_out f) in - print_packed_sources (ppf_of_file "doc/Camlp4.ml4") camlp4_package; + (* print_packed_sources (ppf_of_file "doc/Camlp4.ml4") camlp4_package; print_packed_sources (ppf_of_file "doc/Camlp4Parsers.ml4") camlp4_parsers; print_packed_sources (ppf_of_file "doc/Camlp4Filters.ml4") camlp4_filters; print_packed_sources (ppf_of_file "doc/Camlp4Top.ml4") camlp4_top; revised_to_ocaml "doc/Camlp4"; sed "(\\*___CAMLP4_LEXER___" "" "doc/Camlp4.ml"; - sed "___CAMLP4_LEXER___\\*)" "" "doc/Camlp4.ml"; + sed "___CAMLP4_LEXER___\\+|" "" "doc/Camlp4.ml"; sed "^ *# [0-9]\\+.*$" "" "doc/Camlp4.ml"; revised_to_ocaml "doc/Camlp4Parsers"; revised_to_ocaml "doc/Camlp4Filters"; - revised_to_ocaml "doc/Camlp4Top"; + revised_to_ocaml "doc/Camlp4Top"; *) ocamldoc "Camlp4 a Pre-Processor-Pretty-Printer for Objective Caml" ["Camlp4.ml"; "Camlp4Parsers.ml"; "Camlp4Filters.ml"; "Camlp4Top.ml"] diff --git a/camlp4/unmaintained/extfold/extfold.ml b/camlp4/unmaintained/extfold/extfold.ml deleted file mode 100644 index 27defc93b..000000000 --- a/camlp4/unmaintained/extfold/extfold.ml +++ /dev/null @@ -1,91 +0,0 @@ -(* camlp4r *) -(* $Id$ *) - -type t 'te 'a 'b = - Gramext.g_entry 'te -> list (Gramext.g_symbol 'te) -> - (Stream.t 'te -> 'a) -> Stream.t 'te -> 'b -; - -type tsep 'te 'a 'b = - Gramext.g_entry 'te -> list (Gramext.g_symbol 'te) -> - (Stream.t 'te -> 'a) -> (Stream.t 'te -> unit) -> Stream.t 'te -> 'b -; - -value gen_fold0 final f e entry symbl psymb = - let rec fold accu = - parser - [ [: a = psymb; s :] -> fold (f a accu) s - | [: :] -> accu ] - in - parser [: a = fold e :] -> final a -; - -value gen_fold1 final f e entry symbl psymb = - let rec fold accu = - parser - [ [: a = psymb; s :] -> fold (f a accu) s - | [: :] -> accu ] - in - parser [: a = psymb; a = fold (f a e) :] -> final a -; - -value gen_fold0sep final f e entry symbl psymb psep = - let failed = - fun - [ [symb; sep] -> Grammar.symb_failed_txt entry sep symb - | _ -> "failed" ] - in - let rec kont accu = - parser - [ [: v = psep; a = psymb ? failed symbl; s :] -> kont (f a accu) s - | [: :] -> accu ] - in - parser - [ [: a = psymb; s :] -> final (kont (f a e) s) - | [: :] -> e ] -; - -value gen_fold1sep final f e entry symbl psymb psep = - let failed = - fun - [ [symb; sep] -> Grammar.symb_failed_txt entry sep symb - | _ -> "failed" ] - in - let parse_top = - fun - [ [symb; _] -> Grammar.parse_top_symb entry symb Loc.ghost - | _ -> raise Stream.Failure ] - in - let rec kont accu = - parser - [ [: v = psep; - a = - parser - [ [: a = psymb :] -> a - | [: a = parse_top symbl :] -> Obj.magic a - | [: :] -> raise (Stream.Error (failed symbl)) ]; - s :] -> - kont (f a accu) s - | [: :] -> accu ] - in - parser [: a = psymb; s :] -> final (kont (f a e) s) -; - -value sfold0 f e = gen_fold0 (fun x -> x) f e; -value sfold1 f e = gen_fold1 (fun x -> x) f e; -value sfold0sep f e = gen_fold0sep (fun x -> x) f e; -value sfold1sep f e = gen_fold1sep (fun x -> x) f e; - -value cons x y = [x :: y]; -value nil = []; - -value slist0 entry = gen_fold0 List.rev cons nil entry; -value slist1 entry = gen_fold1 List.rev cons nil entry; -value slist0sep entry = gen_fold0sep List.rev cons nil entry; -value slist1sep entry = gen_fold1sep List.rev cons nil entry; - -value sopt entry symbl psymb = - parser - [ [: a = psymb :] -> Some a - | [: :] -> None ] -; diff --git a/camlp4/unmaintained/extfold/extfold.mli b/camlp4/unmaintained/extfold/extfold.mli deleted file mode 100644 index 639631e27..000000000 --- a/camlp4/unmaintained/extfold/extfold.mli +++ /dev/null @@ -1,24 +0,0 @@ -(* camlp4r *) -(* $Id$ *) - -type t 'te 'a 'b = - Gramext.g_entry 'te -> list (Gramext.g_symbol 'te) -> - (Stream.t 'te -> 'a) -> Stream.t 'te -> 'b -; - -type tsep 'te 'a 'b = - Gramext.g_entry 'te -> list (Gramext.g_symbol 'te) -> - (Stream.t 'te -> 'a) -> (Stream.t 'te -> unit) -> Stream.t 'te -> 'b -; - -value sfold0 : ('a -> 'b -> 'b) -> 'b -> t _ 'a 'b; -value sfold1 : ('a -> 'b -> 'b) -> 'b -> t _ 'a 'b; -value sfold0sep : ('a -> 'b -> 'b) -> 'b -> tsep _ 'a 'b; -value sfold1sep : ('a -> 'b -> 'b) -> 'b -> tsep _ 'a 'b; - -value slist0 : t _ 'a (list 'a); -value slist1 : t _ 'a (list 'a); -value slist0sep : tsep _ 'a (list 'a); -value slist1sep : tsep _ 'a (list 'a); - -value sopt : t _ 'a (option 'a); |