Commits

camlspotter committed dff96b8

imported updates in custom-3.12.0

Comments (0)

Files changed (6)

0patches/camlp4-lexer-plugin-0.5-for-3.11.2.patch

+diff -r 734e81f730d9 camlp4/Camlp4/Sig.ml
+--- a/camlp4/Camlp4/Sig.ml	Thu Sep 17 18:16:35 2009 +0900
++++ b/camlp4/Camlp4/Sig.ml	Mon Sep 14 10:49:43 2009 +0900
+@@ -1087,6 +1087,10 @@
+     value lex_string : Loc.t -> string
+                             -> not_filtered (Stream.t (Token.t * Loc.t));
+ 
++    value set_from_lexbuf : 
++      (?quotations: bool -> Lexing.lexbuf -> Stream.t (Token.t * Loc.t)) 
++    -> unit;
++      
+     (** Filter a token stream using the {!Token.Filter} module *)
+     value filter : not_filtered (Stream.t (Token.t * Loc.t))
+                               -> Stream.t (Token.t * Loc.t);
+@@ -1121,6 +1125,12 @@
+       The lexer do not use global (mutable) variables: instantiations
+       of [Lexer.mk ()] do not perturb each other. *)
+   value mk : unit -> (Loc.t -> Stream.t char -> Stream.t (Token.t * Loc.t));
++
++  value from_lexbuf : 
++    ?quotations: bool -> Lexing.lexbuf -> Stream.t (Token.t * Loc.t);
++
++  value set_from_lexbuf : 
++    (?quotations: bool -> Lexing.lexbuf -> Stream.t (Token.t * Loc.t)) -> unit;
+ end;
+ 
+ 
+diff -r 734e81f730d9 camlp4/Camlp4/Struct/Grammar/Static.ml
+--- a/camlp4/Camlp4/Struct/Grammar/Static.ml	Thu Sep 17 18:16:35 2009 +0900
++++ b/camlp4/Camlp4/Struct/Grammar/Static.ml	Mon Sep 14 10:49:43 2009 +0900
+@@ -59,6 +59,8 @@
+ 
+   value lex_string loc str = lex loc (Stream.of_string str);
+ 
++  value set_from_lexbuf = Lexer.set_from_lexbuf;
++
+   value filter ts = Token.Filter.filter gram.gfilter ts;
+ 
+   value parse_tokens_after_filter entry ts = Entry.E.parse_tokens_after_filter entry ts;
+diff -r 734e81f730d9 camlp4/Camlp4/Struct/Lexer.mll
+--- a/camlp4/Camlp4/Struct/Lexer.mll	Thu Sep 17 18:16:35 2009 +0900
++++ b/camlp4/Camlp4/Struct/Lexer.mll	Mon Sep 14 10:49:43 2009 +0900
+@@ -448,7 +448,12 @@
+     in
+     self 0 s
+ 
+-  let from_context c =
++  let from_context quotations lb =
++    let c = { (default_context lb) with
++              loc        = Loc.of_lexbuf lb;
++              antiquots  = !Camlp4_config.antiquotations;
++              quotations = quotations      }
++    in
+     let next _ =
+       let tok = with_curr_loc token c in
+       let loc = Loc.of_lexbuf c.lexbuf in
+@@ -456,11 +461,19 @@
+     in Stream.from next
+ 
+   let from_lexbuf ?(quotations = true) lb =
+-    let c = { (default_context lb) with
+-              loc        = Loc.of_lexbuf lb;
+-              antiquots  = !Camlp4_config.antiquotations;
+-              quotations = quotations      }
+-    in from_context c
++    from_context quotations lb
++
++  let from_lexbuf_ref = ref from_lexbuf
++
++  let set_from_lexbuf from_lexbuf = from_lexbuf_ref := from_lexbuf
++
++  let from_lexbuf ?(quotations = true) lb =
++    let zstream = lazy (!from_lexbuf_ref ~quotations lb) in
++    Stream.from (fun _ ->
++      try
++	Some (Stream.next (Lazy.force zstream))
++      with
++      | Stream.Failure -> None)
+ 
+   let setup_loc lb loc =
+     let start_pos = Loc.start_pos loc in
+diff -r 734e81f730d9 camlp4/Camlp4Top/Top.ml
+--- a/camlp4/Camlp4Top/Top.ml	Thu Sep 17 18:16:35 2009 +0900
++++ b/camlp4/Camlp4Top/Top.ml	Mon Sep 14 10:49:43 2009 +0900
+@@ -50,7 +50,8 @@
+ open Syntax;
+ open Camlp4.Sig;
+ module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make Ast;
+-module Lexer = Camlp4.Struct.Lexer.Make Token;
++(* module Lexer = Camlp4.Struct.Lexer.Make Token; *)
++module Lexer = PreCast.Lexer;
+ 
+ external not_filtered : 'a -> Gram.not_filtered 'a = "%identity";
+ 

ocamlspot/ocamlspot.ml

   let file f = File.dump_file f
   ;;
 
-  let rannots file = 
+  let rannots_full file = 
     Format.eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
       (Format.list "; " (Regioned.format Annot.format))
       file.File.rannots
   ;;
   
+  let rannots_summary file = 
+    Format.eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
+      (Format.list "; " (Regioned.format Annot.summary))
+      file.File.rannots
+  ;;
+  
   let tree file = Tree.dump !!(file.File.tree)
   ;;
 
     let file = File.load ~load_paths: ["."] path in
     
     if C.dump_file then Dump.file file;
-    if C.dump_rannots then Dump.rannots file;
+    if C.dump_rannots = `Full then Dump.rannots_full file;
+    if C.dump_rannots = `Summary then Dump.rannots_summary file;
     if C.dump_tree then Dump.tree file;
     if C.dump_top then Dump.top file;
     if C.dump_flat then Dump.flat file;

ocamlspot/spotapi.ml

     | Non_expansive b ->
         Format.fprintf ppf "Non_expansive: %b" b
 
+  let summary ppf = function
+    | Type _typ -> 
+        (* CR jfuruse: not fancy having @. *)
+	Format.fprintf ppf "Type: ...@ ";
+	Format.fprintf ppf "XType: ..."
+    | Mod_type _mty -> 
+	Format.fprintf ppf "Type: ...@ ";
+	Format.fprintf ppf "XType: ..."
+    | Str _str ->
+	Format.fprintf ppf "Str: ..."
+    | Use (use, path) ->
+	Format.fprintf ppf "Use: %s, %s" 
+	  (String.capitalize (Kind.name use)) (Path.name path)
+    | Module _mexp ->
+	Format.fprintf ppf "Module: ..."
+    | Functor_parameter id ->
+	Format.fprintf ppf "Functor_parameter: %s" (Ident.name id)
+    | Non_expansive b ->
+        Format.fprintf ppf "Non_expansive: %b" b
+
   let dummy = Use (Kind.Value, Path.Pident (Ident.create_persistent "dummy"))
 end 
 
     end_ : Position.t
   }
 
-  let of_parsing l =
-    { start = Position.of_lexing_position l.Location.loc_start;
-      end_ = Position.of_lexing_position l.Location.loc_end }
-
   let to_string t =
     Printf.sprintf "%s:%s"
       (Position.to_string t.start)
       (Position.to_string t.end_)
 
+  let of_parsing l =
+    let start = Position.of_lexing_position l.Location.loc_start in
+    let end_ = Position.of_lexing_position l.Location.loc_end in
+    match Position.compare start end_ with
+    | -1 | 0 -> { start = start; end_ = end_ }
+    | _ -> 
+        let pos = { start = start; end_ = end_ } in
+        Format.eprintf "MALFORMED LOCATION %s@." (to_string pos);
+        { start = start; end_ = start }
+
   let compare l1 l2 = 
     if Position.compare l1.start l2.start = 0 
        && Position.compare l2.end_ l1.end_ = 0 then `Same

ocamlspot/spotapi.mli

   val recorded : unit -> (Location.t * t) list
 
   val format : Format.formatter -> t -> unit
+  val summary : Format.formatter -> t -> unit
+  (** same as [format] but bigger structures are omitted *)    
 
   val dummy : t
 end

ocamlspot/spotconfig.ml

     
 let rev_anonargs = ref []
 let dump_file = ref false
-let dump_rannots = ref false
+let dump_rannots = ref `None
 let dump_tree = ref false
 let dump_top = ref false
 let dump_flat = ref false
       "--debug", Arg.Set Debug.on, "\t: print debug information";
       "-debug", Arg.Set Debug.on, "\t: (deprecated)";
       "--dump-file", Arg.Set dump_file, "\t: dump spot file"; 
-      "--dump-rannots", Arg.Set dump_rannots, "\t: dump loc-annots";
+      "--dump-rannots", Arg.Unit (fun () -> dump_rannots := `Full), "\t: dump loc-annots";
+      "--dump-rannots-summary", Arg.Unit (fun () -> dump_rannots := `Summary), "\t: dump loc-annots";
       "--dump-tree", Arg.Set dump_tree, "\t: dump annot tree";
       "--dump-top", Arg.Set dump_top, "\t: dump top"; 
       "--dump-flat", Arg.Set dump_flat, "\t: dump flat"; 
 let print_interface = !print_interface
 
 let dump_any = 
-  dump_file || dump_rannots || dump_tree || dump_top || dump_flat
+  dump_file || dump_rannots <> `None || dump_tree || dump_top || dump_flat
 
 module SearchSpec = struct
   type t = 

ocamlspot/spotconfig_intf.ml

   val print_version : unit -> unit
   
   val dump_file : bool
-  val dump_rannots : bool
+  val dump_rannots : [ `None | `Full | `Summary ]
   val dump_tree : bool
   val dump_top : bool
   val dump_flat : bool