* PXP patch for ocaml-3.09.0
@ 2005-10-28 9:32 Alessandro Baretta
0 siblings, 0 replies; only message in thread
From: Alessandro Baretta @ 2005-10-28 9:32 UTC (permalink / raw)
To: Gerd Stolpmann, Ocaml
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$ >>
;;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2005-10-28 9:30 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2005-10-28 9:32 PXP patch for ocaml-3.09.0 Alessandro Baretta
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).