Version française
Home     About     Download     Resources     Contact us    
Browse thread
PXP patch for ocaml-3.09.0
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Alessandro Baretta <a.baretta@b...>
Subject: PXP patch for ocaml-3.09.0
The following patch against pxp-1.1.95 provides support for ocaml-3.09.0

diff -Naur --exclude '*~' --exclude '*.cm*' 
pxp-1.1.95/src/pxp-pp/pxp_pp.ml pxp-1.1.95-deit/src/pxp-pp/pxp_pp.ml
--- pxp-1.1.95/src/pxp-pp/pxp_pp.ml	2004-09-04 19:48:32.000000000 +0200
+++ pxp-1.1.95-deit/src/pxp-pp/pxp_pp.ml	2005-10-28 11:28:31.000000000 +0200
@@ -665,23 +665,23 @@
  	raise_at p1 p2 (Failure("pxp-pp: Typing error: " ^ msg))
  ;;

-
-let generate_list loc el =
-  List.fold_right (fun x l -> <:expr< [$x$ :: $l$] >>) el <:expr< [] >>
-;;
-
-
-let generate_ann_list loc el =
-  List.fold_right (fun (ann,x) l ->
-		     match ann with
-			 `Single -> <:expr< [$x$ :: $l$] >>
-		       | `List   -> <:expr< $x$ @ $l$ >>)
+let generate_list _loc el =
+  let loc = _loc in
+    List.fold_right (fun x l -> <:expr< [$x$ :: $l$] >>) el <:expr< [] >>
+
+let generate_ann_list _loc el =
+  let loc = _loc in
+    List.fold_right (fun (ann,x) l ->
+		       match ann with
+			   `Single -> <:expr< [$x$ :: $l$] >>
+		         | `List   -> <:expr< $x$ @ $l$ >>)
                    el
                    <:expr< [] >>
  ;;


-let generate_ident loc name =
+let generate_ident _loc name =
+  let loc = _loc in
    (* TODO: "." separation *)
    (* TODO: Convert back to latin 1 *)
    <:expr< $lid:name$ >>
@@ -694,7 +694,8 @@
    check_file();

    let valcheck_expr =
-    let loc = mkloc (0,0,0) (0,0,0) in
+    let _loc = mkloc (0,0,0) (0,0,0) in
+    let loc = _loc in
      if valcheck then <:expr< True >> else <:expr< False >> in

    let to_rep s =
@@ -714,7 +715,8 @@
      (* nsmode: Whether there is a variable [scope] in the environment *)
      function
  	(`Element(name,attrs,subnodes),p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let name_expr = generate_for_string_expr name in
  	  let attrs_expr_l = List.map generate_for_attr_expr attrs in
  	  let attrs_expr = generate_ann_list loc attrs_expr_l in
@@ -740,28 +742,33 @@
                         node } >>
        | (`Data text,p1,p2) ->
  	  let text_expr = generate_for_string_expr text in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  <:expr< Pxp_document.create_data_node spec dtd $text_expr$ >>
        | (`Comment text,p1,p2) ->
  	  let text_expr = generate_for_string_expr text in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  <:expr< Pxp_document.create_comment_node spec dtd $text_expr$ >>
        | (`PI(target,value),p1,p2) ->
  	  let target_expr = generate_for_string_expr target in
  	  let value_expr = generate_for_string_expr value in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  <:expr< Pxp_document.create_pinstr_node spec dtd
  	          (new Pxp_dtd.proc_instruction
                           $target_expr$ $value_expr$ dtd#encoding)
  	        >>
        | (`Super subnodes,p1,p2) ->
  	  let subnodes_expr = generate_for_nodelist_expr nsmode subnodes in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  <:expr< let node = Pxp_document.create_super_root_node spec dtd in
                    do { node # set_nodes $subnodes_expr$;
  	               node } >>
        | (`Meta(name,attrs,subnode),p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  ( match name with
  		"scope"      -> generate_scope loc attrs subnode
  	      | "autoscope"  -> generate_autoscope loc subnode
@@ -769,7 +776,8 @@
  	      | _            -> assert false (* already caught above *)
  	  )
        | (`Ident name,p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  generate_ident loc (to_src name)
        | (`Anti text,p1,p2) ->
  	  Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string (to_src text))
@@ -780,16 +788,19 @@
    and generate_for_nodelist_expr nsmode : ast_node_list -> MLast.expr = (
      function
  	(`Nodes l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map (generate_for_node_expr nsmode) l in
  	  generate_list loc l'
        | (`Concat l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map (generate_for_nodelist_expr nsmode) l in
  	  let l'' = generate_list loc l' in
  	  <:expr< List.concat $l''$ >>
        | (`Ident name, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  generate_ident loc (to_src name)
        | (`Anti text, p1, p2) ->
  	  Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string (to_src text))
@@ -798,7 +809,8 @@
    and generate_for_attr_expr : ast_attr -> [`Single|`List] * 
MLast.expr = (
      function
  	(`Attr(n,v), p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let n_expr = generate_for_string_expr n in
  	  let v_expr = generate_for_string_expr v in
  	  `Single, <:expr< ($n_expr$, $v_expr$) >>
@@ -808,6 +820,7 @@
    )

    and generate_scope loc attrs subnode : MLast.expr = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      if attrs = [] then
        subexpr
@@ -822,6 +835,7 @@
    )

    and generate_autoscope loc subnode : MLast.expr = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      <:expr< let scope =
              ( let mng = dtd # namespace_manager in
@@ -830,6 +844,7 @@
    )

    and generate_emptyscope loc subnode : MLast.expr = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      <:expr< let scope =
              ( let mng = dtd # namespace_manager in
@@ -840,16 +855,19 @@
    and generate_for_string_expr : ast_string -> MLast.expr = (
      function
  	(`Literal s, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let s' = to_rep s in
  	  <:expr< $str:s'$ >>
        | (`Concat l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map generate_for_string_expr l in
  	  let l'' = generate_list loc l' in
  	  <:expr< String.concat "" $l''$ >>
        | (`Ident name, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  generate_ident loc (to_src name)
        | (`Anti text, p1, p2) ->
  	  Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string (to_src text))
@@ -863,7 +881,8 @@
         let ast = call_parser parse_any_expr stream in
         let ast' = check_any_expr ast in
         let ocaml_expr = generate_for_any_expr ast' in
-       let loc = mkloc (1,0,0) (last_pos stream) in
+       let _loc = mkloc (1,0,0) (last_pos stream) in
+       let loc = _loc in
         <:expr< $anti:ocaml_expr$ >>
      )
  ;;
@@ -912,6 +931,7 @@
        ~in_enc:`Enc_utf8 ~out_enc:(!current_decl.source_enc) s in

    let rec generate_for_any_expr loc : ast_any_node -> MLast.expr =
+    let _loc = loc in
      function
  	`Node n ->
  	  let e = generate_tree (generate_for_node_expr false n) in
@@ -924,7 +944,8 @@
      (* nsmode: Whether there is a variable [scope] in the environment *)
      function
  	(`Element(name,attrs,subnodes),p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let name_expr = generate_for_string_expr name in
  	  let attrs_expr_l = List.map generate_for_attr_expr attrs in
  	  let attrs_expr = generate_ann_list loc attrs_expr_l in
@@ -943,25 +964,30 @@
  	  [`Single, start_tag] @ subnodes_expr @ [`Single, end_tag]
        | (`Data text,p1,p2) ->
  	  let text_expr = generate_for_string_expr text in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  [ `Single, <:expr< Pxp_types.E_char_data($text_expr$) >> ]
        | (`Comment text,p1,p2) ->
  	  let text_expr = generate_for_string_expr text in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  [ `Single, <:expr< Pxp_types.E_comment($text_expr$) >> ]
        | (`PI(target,value),p1,p2) ->
  	  let target_expr = generate_for_string_expr target in
  	  let value_expr = generate_for_string_expr value in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  [ `Single, <:expr< 
Pxp_types.E_pinstr($target_expr$,$value_expr$,_eid) >> ]
        | (`Super subnodes,p1,p2) ->
  	  let subnodes_expr = generate_for_nodelist_expr nsmode subnodes in
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  ( [ `Single, <:expr< Pxp_types.E_start_super >> ] @
  	    subnodes_expr @
  	    [ `Single, <:expr< Pxp_types.E_end_super >> ] )
        | (`Meta(name,attrs,subnode),p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  ( match name with
  		"scope"      -> generate_scope loc attrs subnode
  	      | "autoscope"  -> generate_autoscope loc subnode
@@ -969,7 +995,8 @@
  	      | _            -> assert false (* already caught above *)
  	  )
        | (`Ident name,p1,p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  [ `Tree, (generate_ident loc (to_src name)) ]
        | (`Anti text,p1,p2) ->
  	  let expr =
@@ -984,15 +1011,18 @@
                                   ast_node_list -> (ann * MLast.expr) 
list = (
      function
  	(`Nodes l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map (generate_for_node_expr nsmode) l in
  	  List.flatten l'
        | (`Concat l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map (generate_for_nodelist_expr nsmode) l in
  	  List.flatten l'
        | (`Ident name, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  [ `Forest, (generate_ident loc (to_src name)) ]
        | (`Anti text, p1, p2) ->
  	  let expr =
@@ -1004,7 +1034,8 @@
    and generate_for_attr_expr : ast_attr -> [`Single|`List] * 
MLast.expr = (
      function
  	(`Attr(n,v), p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let n_expr = generate_for_string_expr n in
  	  let v_expr = generate_for_string_expr v in
  	  `Single, <:expr< ($n_expr$, $v_expr$) >>
@@ -1014,6 +1045,7 @@
    )

    and generate_scope loc attrs subnode : (ann * MLast.expr) list = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      if attrs = [] then
        subexpr
@@ -1031,6 +1063,7 @@
    )

    and generate_autoscope loc subnode : (ann * MLast.expr) list = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      let compiled_subexpr = generate_tree subexpr in
      let scope_expr =
@@ -1041,6 +1074,7 @@
    )

    and generate_emptyscope loc subnode : (ann * MLast.expr) list = (
+    let _loc = loc in
      let subexpr = generate_for_node_expr true subnode in
      let compiled_subexpr = generate_tree subexpr in
      let scope_expr =
@@ -1053,16 +1087,19 @@
    and generate_for_string_expr : ast_string -> MLast.expr = (
      function
  	(`Literal s, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let s' = to_rep s in
  	  <:expr< $str:s'$ >>
        | (`Concat l, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  let l' = List.map generate_for_string_expr l in
  	  let l'' = generate_list loc l' in
  	  <:expr< String.concat "" $l''$ >>
        | (`Ident name, p1, p2) ->
-	  let loc = mkloc p1 p2 in
+	  let _loc = mkloc p1 p2 in
+          let loc = _loc in
  	  generate_ident loc (to_src name)
        | (`Anti text, p1, p2) ->
  	  Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string (to_src text))
@@ -1075,7 +1112,8 @@
         let stream = scan_string s in
         let ast = call_parser parse_any_expr stream in
         let ast' = check_any_expr ast in
-       let loc = mkloc (1,0,0) (last_pos stream) in
+       let _loc = mkloc (1,0,0) (last_pos stream) in
+       let loc = _loc in
         let expr = generate_for_any_expr loc ast' in
         <:expr< $anti:expr$ >>
      )
@@ -1083,7 +1121,8 @@


  let expand_evlist_expr s =
-  let loc = mkloc (0,0,0) (0,0,0) in  (* ??? *)
+  let _loc = mkloc (0,0,0) (0,0,0) in  (* ??? *)
+  let loc = _loc in
    let rec generate_tree annlist =
      match annlist with
  	(`Single, e) :: annlist' ->
@@ -1102,7 +1141,8 @@


  let expand_evpull_expr s =
-  let loc = mkloc (0,0,0) (0,0,0) in  (* ??? *)
+  let _loc = mkloc (0,0,0) (0,0,0) in  (* ??? *)
+  let loc = _loc in
    let generate_tree annlist =
      let rec generate_match k annlist =
        match annlist with
@@ -1156,7 +1196,8 @@
         let stream = scan_string s in
         let decl = call_parser parse_charset_decl stream in
         current_decl := decl;
-       let loc = mkloc (1,0,0) (last_pos stream) in
+       let _loc = mkloc (1,0,0) (last_pos stream) in
+       let loc = _loc in
         <:expr< () >>
      )
  ;;
@@ -1164,7 +1205,8 @@

  let expand_text_expr s =
    check_file();
-  let loc = mkloc (1,0,0) (1,0,String.length s) in
+  let _loc = mkloc (1,0,0) (1,0,String.length s) in
+  let loc = _loc in
    <:expr< $str:s$ >>
  ;;