--- /dev/null
+Index: CHANGES
+===================================================================
+retrieving revision 6.36
+retrieving revision 6.38
+diff -c -r6.36 -r6.38
+*** CHANGES 15 Mar 2011 12:36:08 -0000 6.36
+--- CHANGES 16 Mar 2011 16:52:42 -0000 6.38
+***************
+*** 1,3 ****
+--- 1,11 ----
++ Camlp5 Version 6.02.3:
++ ----------------------
++
++ * [16 Mar 11] Fixed bug: incorrect compilation of label patterns of the
++ form ~a:b (or ~{a = b} in revised syntax) in class declarations.
++ * [16 Mar 11] Fixed bug: error while printing label patterns ~a:b with
++ pr_o.cmo (error message "labels not pretty printed (in patt)").
++
+ Camlp5 Version 6.02.2:
+ ----------------------
+
+Index: etc/pr_o.ml
+===================================================================
+retrieving revision 6.51
+diff -c -r6.51 pr_o.ml
+*** etc/pr_o.ml 15 Mar 2011 13:49:10 -0000 6.51
+--- etc/pr_o.ml 16 Mar 2011 15:18:58 -0000
+***************
+*** 1363,1369 ****
+ | <:patt< _ >> -> pprintf pc "_"
+ | <:patt:< ?{$_$} >> | <:patt:< ?{$_$ = $_$} >> | <:patt:< ?{$_$} >> |
+ <:patt:< ?{$_$ = ?{$_$ = $_$}} >> | <:patt:< ?{$_$ = $_$} >> |
+! <:patt:< ~{$_$} >> | <:patt:< ~{$_$ = $_$} >> ->
+ error loc "labels not pretty printed (in patt)"
+ | <:patt< `$s$ >> ->
+ failwith "polymorphic variants not pretty printed; add pr_ro.cmo"
+--- 1363,1369 ----
+ | <:patt< _ >> -> pprintf pc "_"
+ | <:patt:< ?{$_$} >> | <:patt:< ?{$_$ = $_$} >> | <:patt:< ?{$_$} >> |
+ <:patt:< ?{$_$ = ?{$_$ = $_$}} >> | <:patt:< ?{$_$ = $_$} >> |
+! <:patt:< ~{$list:_$} >> ->
+ error loc "labels not pretty printed (in patt)"
+ | <:patt< `$s$ >> ->
+ failwith "polymorphic variants not pretty printed; add pr_ro.cmo"
+Index: main/ast2pt.ml
+===================================================================
+retrieving revision 6.32
+diff -c -r6.32 ast2pt.ml
+*** main/ast2pt.ml 15 Mar 2011 12:36:08 -0000 6.32
+--- main/ast2pt.ml 16 Mar 2011 15:57:40 -0000
+***************
+*** 1326,1341 ****
+ [ Some pcl_fun ->
+ match uv lppo with
+ [ [(p, po)] -> do {
+- let _ =
+- match uv po with
+- [ Some _ -> error loc "label not implemented in that case 1"
+- | None -> None ]
+- in
+ let lab =
+ match p with
+ [ PaLid _ s -> uv s
+ | p -> error loc "label not implemented in that case 2" ]
+ in
+ mkpcl loc (pcl_fun lab None (patt p) (class_expr ce))
+ }
+ | [] | [_ :: _] -> error ploc "case class multi lab not yet impl" ]
+--- 1326,1341 ----
+ [ Some pcl_fun ->
+ match uv lppo with
+ [ [(p, po)] -> do {
+ let lab =
+ match p with
+ [ PaLid _ s -> uv s
+ | p -> error loc "label not implemented in that case 2" ]
+ in
++ let p =
++ match uv po with
++ [ Some p -> p
++ | None -> p ]
++ in
+ mkpcl loc (pcl_fun lab None (patt p) (class_expr ce))
+ }
+ | [] | [_ :: _] -> error ploc "case class multi lab not yet impl" ]
+Index: ocaml_src/main/ast2pt.ml
+===================================================================
+retrieving revision 6.32
+diff -c -r6.32 ast2pt.ml
+*** ocaml_src/main/ast2pt.ml 15 Mar 2011 12:36:09 -0000 6.32
+--- ocaml_src/main/ast2pt.ml 16 Mar 2011 16:05:41 -0000
+***************
+*** 1522,1537 ****
+ Some pcl_fun ->
+ begin match uv lppo with
+ [p, po] ->
+- let _ =
+- match uv po with
+- Some _ -> error loc "label not implemented in that case 1"
+- | None -> None
+- in
+ let lab =
+ match p with
+ PaLid (_, s) -> uv s
+ | p -> error loc "label not implemented in that case 2"
+ in
+ mkpcl loc (pcl_fun lab None (patt p) (class_expr ce))
+ | [] | _ :: _ -> error ploc "case class multi lab not yet impl"
+ end
+--- 1522,1537 ----
+ Some pcl_fun ->
+ begin match uv lppo with
+ [p, po] ->
+ let lab =
+ match p with
+ PaLid (_, s) -> uv s
+ | p -> error loc "label not implemented in that case 2"
+ in
++ let p =
++ match uv po with
++ Some p -> p
++ | None -> p
++ in
+ mkpcl loc (pcl_fun lab None (patt p) (class_expr ce))
+ | [] | _ :: _ -> error ploc "case class multi lab not yet impl"
+ end
--- /dev/null
+Index: main/ast2pt.ml
+===================================================================
+retrieving revision 6.33
+diff -c -r6.33 ast2pt.ml
+*** main/ast2pt.ml 16 Mar 2011 16:52:42 -0000 6.33
+--- main/ast2pt.ml 17 Mar 2011 16:55:32 -0000
+***************
+*** 725,730 ****
+--- 725,737 ----
+ | t -> t ]
+ ;
+
++ value label_of_patt =
++ fun
++ [ PaLid _ s -> uv s
++ | PaTyc _ (PaLid _ s) _ -> uv s
++ | p -> error (MLast.loc_of_patt p) "label_of_patt; case not impl" ]
++ ;
++
+ value rec expr =
+ fun
+ [ ExAcc loc x <:expr< val >> ->
+***************
+*** 856,867 ****
+ [ [(PaLab ploc lppo, w, e)] ->
+ List.fold_right
+ (fun (p, po) e -> do {
+! let lab =
+! match p with
+! [ PaLid _ lab -> uv lab
+! | PaTyc _ (PaLid _ lab) _ -> uv lab
+! | _ -> error loc "not impl label for that patt 1" ]
+! in
+ let p =
+ match uv po with
+ [ Some p -> p
+--- 863,869 ----
+ [ [(PaLab ploc lppo, w, e)] ->
+ List.fold_right
+ (fun (p, po) e -> do {
+! let lab = label_of_patt p in
+ let p =
+ match uv po with
+ [ Some p -> p
+***************
+*** 878,889 ****
+ | None -> mkexp loc (newtype (uv s) (expr e)) ]
+ | None -> error loc "(type ..) not in this ocaml version" ]
+ | [(PaOlb loc p eo, w, e)] ->
+! let lab =
+! match p with
+! [ PaLid _ lab -> uv lab
+! | PaTyc _ (PaLid _ lab) _ -> uv lab
+! | _ -> error loc "not impl label for that patt 2" ]
+! in
+ let (p, eo) =
+ match uv eo with
+ [ Some (ExOlb _ p eo) -> (p, eo)
+--- 880,886 ----
+ | None -> mkexp loc (newtype (uv s) (expr e)) ]
+ | None -> error loc "(type ..) not in this ocaml version" ]
+ | [(PaOlb loc p eo, w, e)] ->
+! let lab = label_of_patt p in
+ let (p, eo) =
+ match uv eo with
+ [ Some (ExOlb _ p eo) -> (p, eo)
+***************
+*** 1326,1336 ****
+ [ Some pcl_fun ->
+ match uv lppo with
+ [ [(p, po)] -> do {
+! let lab =
+! match p with
+! [ PaLid _ s -> uv s
+! | p -> error loc "label not implemented in that case 2" ]
+! in
+ let p =
+ match uv po with
+ [ Some p -> p
+--- 1323,1329 ----
+ [ Some pcl_fun ->
+ match uv lppo with
+ [ [(p, po)] -> do {
+! let lab = label_of_patt p in
+ let p =
+ match uv po with
+ [ Some p -> p
+***************
+*** 1343,1353 ****
+ | CeFun loc (PaOlb _ p eo) ce ->
+ match ocaml_pcl_fun with
+ [ Some pcl_fun ->
+! let lab =
+! match p with
+! [ PaLid _ s -> uv s
+! | p -> error loc "label not implemented in that case 4" ]
+! in
+ let (p, eo) =
+ match uv eo with
+ [ Some (ExOlb _ p eo) -> (p, eo)
+--- 1336,1342 ----
+ | CeFun loc (PaOlb _ p eo) ce ->
+ match ocaml_pcl_fun with
+ [ Some pcl_fun ->
+! let lab = label_of_patt p in
+ let (p, eo) =
+ match uv eo with
+ [ Some (ExOlb _ p eo) -> (p, eo)
+Index: ocaml_src/main/ast2pt.ml
+===================================================================
+retrieving revision 6.33
+diff -c -r6.33 ast2pt.ml
+*** ocaml_src/main/ast2pt.ml 16 Mar 2011 16:52:42 -0000 6.33
+--- ocaml_src/main/ast2pt.ml 17 Mar 2011 16:56:42 -0000
+***************
+*** 881,886 ****
+--- 881,893 ----
+ loop
+ ;;
+
++ let label_of_patt =
++ function
++ PaLid (_, s) -> uv s
++ | PaTyc (_, PaLid (_, s), _) -> uv s
++ | p -> error (MLast.loc_of_patt p) "label_of_patt; case not impl"
++ ;;
++
+ let rec expr =
+ function
+ ExAcc (loc, x, MLast.ExLid (_, "val")) ->
+***************
+*** 1015,1026 ****
+ [PaLab (ploc, lppo), w, e] ->
+ List.fold_right
+ (fun (p, po) e ->
+! let lab =
+! match p with
+! PaLid (_, lab) -> uv lab
+! | PaTyc (_, PaLid (_, lab), _) -> uv lab
+! | _ -> error loc "not impl label for that patt 1"
+! in
+ let p =
+ match uv po with
+ Some p -> p
+--- 1022,1028 ----
+ [PaLab (ploc, lppo), w, e] ->
+ List.fold_right
+ (fun (p, po) e ->
+! let lab = label_of_patt p in
+ let p =
+ match uv po with
+ Some p -> p
+***************
+*** 1038,1049 ****
+ | None -> error loc "(type ..) not in this ocaml version"
+ end
+ | [PaOlb (loc, p, eo), w, e] ->
+! let lab =
+! match p with
+! PaLid (_, lab) -> uv lab
+! | PaTyc (_, PaLid (_, lab), _) -> uv lab
+! | _ -> error loc "not impl label for that patt 2"
+! in
+ let (p, eo) =
+ match uv eo with
+ Some (ExOlb (_, p, eo)) -> p, eo
+--- 1040,1046 ----
+ | None -> error loc "(type ..) not in this ocaml version"
+ end
+ | [PaOlb (loc, p, eo), w, e] ->
+! let lab = label_of_patt p in
+ let (p, eo) =
+ match uv eo with
+ Some (ExOlb (_, p, eo)) -> p, eo
+***************
+*** 1522,1532 ****
+ Some pcl_fun ->
+ begin match uv lppo with
+ [p, po] ->
+! let lab =
+! match p with
+! PaLid (_, s) -> uv s
+! | p -> error loc "label not implemented in that case 2"
+! in
+ let p =
+ match uv po with
+ Some p -> p
+--- 1519,1525 ----
+ Some pcl_fun ->
+ begin match uv lppo with
+ [p, po] ->
+! let lab = label_of_patt p in
+ let p =
+ match uv po with
+ Some p -> p
+***************
+*** 1540,1550 ****
+ | CeFun (loc, PaOlb (_, p, eo), ce) ->
+ begin match ocaml_pcl_fun with
+ Some pcl_fun ->
+! let lab =
+! match p with
+! PaLid (_, s) -> uv s
+! | p -> error loc "label not implemented in that case 4"
+! in
+ let (p, eo) =
+ match uv eo with
+ Some (ExOlb (_, p, eo)) -> p, eo
+--- 1533,1539 ----
+ | CeFun (loc, PaOlb (_, p, eo), ce) ->
+ begin match ocaml_pcl_fun with
+ Some pcl_fun ->
+! let lab = label_of_patt p in
+ let (p, eo) =
+ match uv eo with
+ Some (ExOlb (_, p, eo)) -> p, eo
--- /dev/null
+Index: CHANGES
+===================================================================
+retrieving revision 6.38
+diff -c -r6.38 CHANGES
+*** CHANGES 16 Mar 2011 16:52:42 -0000 6.38
+--- CHANGES 24 Mar 2011 15:22:59 -0000
+***************
+*** 1,6 ****
+--- 1,7 ----
+ Camlp5 Version 6.02.3:
+ ----------------------
+
++ * [24 Mar 11] Fixed bug: M.(a+b) was refused in normal syntax.
+ * [16 Mar 11] Fixed bug: incorrect compilation of label patterns of the
+ form ~a:b (or ~{a = b} in revised syntax) in class declarations.
+ * [16 Mar 11] Fixed bug: error while printing label patterns ~a:b with
+Index: etc/pa_o.ml
+===================================================================
+retrieving revision 6.34
+diff -c -r6.34 pa_o.ml
+*** etc/pa_o.ml 15 Mar 2011 13:49:08 -0000 6.34
+--- etc/pa_o.ml 24 Mar 2011 15:19:05 -0000
+***************
+*** 720,726 ****
+ in
+ loop <:expr< $_uid:i$ >> j
+ | i = V UIDENT; "."; "("; j = operator_rparen ->
+! <:expr< $_uid:i$ . $lid:j$ >> ] ]
+ ;
+ (* Patterns *)
+ patt:
+--- 720,728 ----
+ in
+ loop <:expr< $_uid:i$ >> j
+ | i = V UIDENT; "."; "("; j = operator_rparen ->
+! <:expr< $_uid:i$ . $lid:j$ >>
+! | i = V UIDENT; "."; "("; e = expr; ")" ->
+! <:expr< $_uid:i$ . ( $e$ ) >> ] ]
+ ;
+ (* Patterns *)
+ patt: