1017 lines
42 KiB
Plaintext
1017 lines
42 KiB
Plaintext
|
This patch (against OCaml 3.07) fixes the following issues:
|
||
|
|
||
|
- Camlp4: parsing of labeled function arguments.
|
||
|
- Emacs interface: portability issues between versions of GnuEmacs and XEmacs.
|
||
|
- Incorrect code generated for certain recursive module definitions.
|
||
|
- Name pollution issue on Mac OS X 10.3.
|
||
|
|
||
|
How to apply this patch:
|
||
|
|
||
|
* Go to the ocaml-3.07 source directory.
|
||
|
|
||
|
* Do "make clean".
|
||
|
|
||
|
* If you already applied the earlier patch ocaml-3.07-patch1.diffs,
|
||
|
un-apply it first by running patch -p1 -R < /path/to/ocaml-3.07-patch1.diffs
|
||
|
|
||
|
* Run patch -p1 < /path/to/ocaml-3.07-patch2.diffs (this patch)
|
||
|
|
||
|
* Compile and install as usual (see file INSTALL).
|
||
|
|
||
|
--------------
|
||
|
|
||
|
Index: csl/bytecomp/translmod.ml
|
||
|
diff -u csl/bytecomp/translmod.ml:1.44 csl/bytecomp/translmod.ml:1.45
|
||
|
--- csl/bytecomp/translmod.ml:1.44 Mon Jul 7 15:42:49 2003
|
||
|
+++ csl/bytecomp/translmod.ml Fri Oct 3 16:36:00 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: translmod.ml,v 1.44 2003/07/07 13:42:49 xleroy Exp $ *)
|
||
|
+(* $Id: translmod.ml,v 1.45 2003/10/03 14:36:00 xleroy Exp $ *)
|
||
|
|
||
|
(* Translation from typed abstract syntax to lambda terms,
|
||
|
for the module language *)
|
||
|
@@ -310,11 +310,12 @@
|
||
|
transl_module Tcoerce_none (field_path rootpath id) modl,
|
||
|
transl_structure (id :: fields) cc rootpath rem)
|
||
|
| Tstr_recmodule bindings :: rem ->
|
||
|
+ let ext_fields = List.rev_append (List.map fst bindings) fields in
|
||
|
compile_recmodule
|
||
|
(fun id modl ->
|
||
|
transl_module Tcoerce_none (field_path rootpath id) modl)
|
||
|
bindings
|
||
|
- (transl_structure (map_end fst bindings fields) cc rootpath rem)
|
||
|
+ (transl_structure ext_fields cc rootpath rem)
|
||
|
| Tstr_modtype(id, decl) :: rem ->
|
||
|
transl_structure fields cc rootpath rem
|
||
|
| Tstr_open path :: rem ->
|
||
|
Index: csl/camlp4/camlp4/ast2pt.ml
|
||
|
diff -u csl/camlp4/camlp4/ast2pt.ml:1.25 csl/camlp4/camlp4/ast2pt.ml:1.26
|
||
|
--- csl/camlp4/camlp4/ast2pt.ml:1.25 Wed Jul 16 20:59:12 2003
|
||
|
+++ csl/camlp4/camlp4/ast2pt.ml Tue Sep 30 16:39:26 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: ast2pt.ml,v 1.25 2003/07/16 18:59:12 mauny Exp $ *)
|
||
|
+(* $Id: ast2pt.ml,v 1.26 2003/09/30 14:39:26 mauny Exp $ *)
|
||
|
|
||
|
open Stdpp;
|
||
|
open MLast;
|
||
|
@@ -177,10 +177,10 @@
|
||
|
| TyObj loc fl v -> mktyp loc (Ptyp_object (meth_list loc fl v))
|
||
|
| TyCls loc id ->
|
||
|
mktyp loc (Ptyp_class (long_id_of_string_list loc id) [] [])
|
||
|
- | TyLab loc _ _ -> error loc "labeled type not allowed here"
|
||
|
+ | TyLab loc _ _ -> error loc "labelled type not allowed here"
|
||
|
| TyLid loc s -> mktyp loc (Ptyp_constr (lident s) [])
|
||
|
- | TyMan loc _ _ -> error loc "type manifest not allowed here"
|
||
|
- | TyOlb loc lab _ -> error loc "labeled type not allowed here"
|
||
|
+ | TyMan loc _ _ -> error loc "manifest type not allowed here"
|
||
|
+ | TyOlb loc lab _ -> error loc "labelled type not allowed here"
|
||
|
| TyPol loc pl t -> mktyp loc (Ptyp_poly pl (ctyp t))
|
||
|
| TyQuo loc s -> mktyp loc (Ptyp_var s)
|
||
|
| TyRec loc _ _ -> error loc "record type not allowed here"
|
||
|
Index: csl/camlp4/etc/pa_o.ml
|
||
|
diff -u csl/camlp4/etc/pa_o.ml:1.52 csl/camlp4/etc/pa_o.ml:1.54
|
||
|
--- csl/camlp4/etc/pa_o.ml:1.52 Thu Sep 25 14:05:05 2003
|
||
|
+++ csl/camlp4/etc/pa_o.ml Tue Sep 30 16:39:38 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: pa_o.ml,v 1.52 2003/09/25 12:05:05 mauny Exp $ *)
|
||
|
+(* $Id: pa_o.ml,v 1.54 2003/09/30 14:39:38 mauny Exp $ *)
|
||
|
|
||
|
open Stdpp;
|
||
|
open Pcaml;
|
||
|
@@ -1148,16 +1148,16 @@
|
||
|
| i = LIDENT -> [i] ] ]
|
||
|
;
|
||
|
(* Labels *)
|
||
|
- ctyp: AFTER "arrow"
|
||
|
- [ NONA
|
||
|
+ ctyp: LEVEL "arrow"
|
||
|
+ [ RIGHTA
|
||
|
[ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
|
||
|
- <:ctyp< ~ $i$ : $t1$ -> $t2$ >>
|
||
|
+ <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >>
|
||
|
| i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
|
||
|
- <:ctyp< ? $i$ : $t1$ -> $t2$ >>
|
||
|
+ <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>
|
||
|
| i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
|
||
|
- <:ctyp< ? $i$ : $t1$ -> $t2$ >>
|
||
|
+ <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>
|
||
|
| "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
|
||
|
- <:ctyp< ? $i$ : $t1$ -> $t2$ >> ] ]
|
||
|
+ <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ]
|
||
|
;
|
||
|
ctyp: LEVEL "simple"
|
||
|
[ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" ->
|
||
|
Index: csl/camlp4/meta/pa_r.ml
|
||
|
diff -u csl/camlp4/meta/pa_r.ml:1.53 csl/camlp4/meta/pa_r.ml:1.55
|
||
|
--- csl/camlp4/meta/pa_r.ml:1.53 Thu Sep 25 14:05:06 2003
|
||
|
+++ csl/camlp4/meta/pa_r.ml Thu Oct 2 14:33:43 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: pa_r.ml,v 1.53 2003/09/25 12:05:06 mauny Exp $ *)
|
||
|
+(* $Id: pa_r.ml,v 1.55 2003/10/02 12:33:43 mauny Exp $ *)
|
||
|
|
||
|
open Stdpp;
|
||
|
open Pcaml;
|
||
|
@@ -542,6 +542,11 @@
|
||
|
<:ctyp< ! $list:pl$ . $t$ >> ]
|
||
|
| "arrow" RIGHTA
|
||
|
[ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ]
|
||
|
+ | "label" NONA
|
||
|
+ [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
||
|
+ | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
||
|
+ | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
|
||
|
+ | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ]
|
||
|
| LEFTA
|
||
|
[ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >> ]
|
||
|
| LEFTA
|
||
|
@@ -746,14 +751,6 @@
|
||
|
class_longident:
|
||
|
[ [ m = UIDENT; "."; l = SELF -> [m :: l]
|
||
|
| i = LIDENT -> [i] ] ]
|
||
|
- ;
|
||
|
- (* Labels *)
|
||
|
- ctyp: AFTER "arrow"
|
||
|
- [ NONA
|
||
|
- [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
||
|
- | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
||
|
- | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
|
||
|
- | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]
|
||
|
;
|
||
|
ctyp: LEVEL "simple"
|
||
|
[ [ "["; "="; rfl = row_field_list; "]" ->
|
||
|
Index: csl/camlp4/meta/q_MLast.ml
|
||
|
diff -u csl/camlp4/meta/q_MLast.ml:1.51 csl/camlp4/meta/q_MLast.ml:1.53
|
||
|
--- csl/camlp4/meta/q_MLast.ml:1.51 Wed Jul 16 14:50:08 2003
|
||
|
+++ csl/camlp4/meta/q_MLast.ml Thu Oct 2 14:33:43 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: q_MLast.ml,v 1.51 2003/07/16 12:50:08 mauny Exp $ *)
|
||
|
+(* $Id: q_MLast.ml,v 1.53 2003/10/02 12:33:43 mauny Exp $ *)
|
||
|
|
||
|
value gram = Grammar.gcreate (Plexer.gmake ());
|
||
|
|
||
|
@@ -127,7 +127,9 @@
|
||
|
value a_STRING = Grammar.Entry.create gram "a_STRING";
|
||
|
value a_CHAR = Grammar.Entry.create gram "a_CHAR";
|
||
|
value a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";
|
||
|
+value a_LABEL = Grammar.Entry.create gram "a_LABEL";
|
||
|
value a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";
|
||
|
+value a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";
|
||
|
|
||
|
value o2b =
|
||
|
fun
|
||
|
@@ -793,6 +795,13 @@
|
||
|
Qast.Node "TyPol" [Qast.Loc; pl; t] ]
|
||
|
| "arrow" RIGHTA
|
||
|
[ t1 = SELF; "->"; t2 = SELF -> Qast.Node "TyArr" [Qast.Loc; t1; t2] ]
|
||
|
+ | "label" NONA
|
||
|
+ [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
|
||
|
+ | i = a_LABEL; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
|
||
|
+ | i = a_QUESTIONIDENT; ":"; t = SELF ->
|
||
|
+ Qast.Node "TyOlb" [Qast.Loc; i; t]
|
||
|
+ | i = a_OPTLABEL; t = SELF ->
|
||
|
+ Qast.Node "TyOlb" [Qast.Loc; i; t] ]
|
||
|
| LEFTA
|
||
|
[ t1 = SELF; t2 = SELF -> Qast.Node "TyApp" [Qast.Loc; t1; t2] ]
|
||
|
| LEFTA
|
||
|
@@ -1006,13 +1015,6 @@
|
||
|
[ [ m = a_UIDENT; "."; l = SELF -> Qast.Cons m l
|
||
|
| i = a_LIDENT -> Qast.List [i] ] ]
|
||
|
;
|
||
|
- (* Labels *)
|
||
|
- ctyp: AFTER "arrow"
|
||
|
- [ NONA
|
||
|
- [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
|
||
|
- | i = a_QUESTIONIDENT; ":"; t = SELF ->
|
||
|
- Qast.Node "TyOlb" [Qast.Loc; i; t] ] ]
|
||
|
- ;
|
||
|
ctyp: LEVEL "simple"
|
||
|
[ [ "["; "="; rfl = row_field_list; "]" ->
|
||
|
Qast.Node "TyVrn" [Qast.Loc; rfl; Qast.Option None]
|
||
|
@@ -1044,11 +1046,16 @@
|
||
|
| "#"; sl = mod_ident -> Qast.Node "PaTyp" [Qast.Loc; sl]
|
||
|
| i = a_TILDEIDENT; ":"; p = SELF ->
|
||
|
Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
|
||
|
+ | i = a_LABEL; p = SELF ->
|
||
|
+ Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
|
||
|
| i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]
|
||
|
| i = a_QUESTIONIDENT; ":"; "("; p = patt_tcon; eo = SOPT eq_expr;
|
||
|
")" ->
|
||
|
Qast.Node "PaOlb"
|
||
|
[Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
|
||
|
+ | i = a_OPTLABEL; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->
|
||
|
+ Qast.Node "PaOlb"
|
||
|
+ [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
|
||
|
| i = a_QUESTIONIDENT ->
|
||
|
Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]
|
||
|
| "?"; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->
|
||
|
@@ -1063,11 +1070,16 @@
|
||
|
ipatt:
|
||
|
[ [ i = a_TILDEIDENT; ":"; p = SELF ->
|
||
|
Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
|
||
|
+ | i = a_LABEL; p = SELF ->
|
||
|
+ Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
|
||
|
| i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]
|
||
|
| i = a_QUESTIONIDENT; ":"; "("; p = ipatt_tcon; eo = SOPT eq_expr;
|
||
|
")" ->
|
||
|
Qast.Node "PaOlb"
|
||
|
[Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
|
||
|
+ | i = a_OPTLABEL; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->
|
||
|
+ Qast.Node "PaOlb"
|
||
|
+ [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
|
||
|
| i = a_QUESTIONIDENT ->
|
||
|
Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]
|
||
|
| "?"; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->
|
||
|
@@ -1086,9 +1098,13 @@
|
||
|
[ "label" NONA
|
||
|
[ i = a_TILDEIDENT; ":"; e = SELF ->
|
||
|
Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]
|
||
|
+ | i = a_LABEL; e = SELF ->
|
||
|
+ Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]
|
||
|
| i = a_TILDEIDENT -> Qast.Node "ExLab" [Qast.Loc; i; Qast.Option None]
|
||
|
| i = a_QUESTIONIDENT; ":"; e = SELF ->
|
||
|
Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]
|
||
|
+ | i = a_OPTLABEL; e = SELF ->
|
||
|
+ Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]
|
||
|
| i = a_QUESTIONIDENT ->
|
||
|
Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option None] ] ]
|
||
|
;
|
||
|
@@ -1335,9 +1351,15 @@
|
||
|
[ [ "~"; a = ANTIQUOT -> antiquot "" loc a
|
||
|
| s = TILDEIDENT -> Qast.Str s ] ]
|
||
|
;
|
||
|
+ a_LABEL:
|
||
|
+ [ [ s = LABEL -> Qast.Str s ] ]
|
||
|
+ ;
|
||
|
a_QUESTIONIDENT:
|
||
|
[ [ "?"; a = ANTIQUOT -> antiquot "" loc a
|
||
|
| s = QUESTIONIDENT -> Qast.Str s ] ]
|
||
|
+ ;
|
||
|
+ a_OPTLABEL:
|
||
|
+ [ [ s = OPTLABEL -> Qast.Str s ] ]
|
||
|
;
|
||
|
END;
|
||
|
|
||
|
Index: csl/camlp4/ocaml_src/camlp4/ast2pt.ml
|
||
|
diff -u csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24 csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.25
|
||
|
--- csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24 Thu Jul 24 00:26:18 2003
|
||
|
+++ csl/camlp4/ocaml_src/camlp4/ast2pt.ml Tue Sep 30 16:39:38 2003
|
||
|
@@ -169,10 +169,10 @@
|
||
|
| TyObj (loc, fl, v) -> mktyp loc (Ptyp_object (meth_list loc fl v))
|
||
|
| TyCls (loc, id) ->
|
||
|
mktyp loc (Ptyp_class (long_id_of_string_list loc id, [], []))
|
||
|
- | TyLab (loc, _, _) -> error loc "labeled type not allowed here"
|
||
|
+ | TyLab (loc, _, _) -> error loc "labelled type not allowed here"
|
||
|
| TyLid (loc, s) -> mktyp loc (Ptyp_constr (lident s, []))
|
||
|
- | TyMan (loc, _, _) -> error loc "type manifest not allowed here"
|
||
|
- | TyOlb (loc, lab, _) -> error loc "labeled type not allowed here"
|
||
|
+ | TyMan (loc, _, _) -> error loc "manifest type not allowed here"
|
||
|
+ | TyOlb (loc, lab, _) -> error loc "labelled type not allowed here"
|
||
|
| TyPol (loc, pl, t) -> mktyp loc (Ptyp_poly (pl, ctyp t))
|
||
|
| TyQuo (loc, s) -> mktyp loc (Ptyp_var s)
|
||
|
| TyRec (loc, _, _) -> error loc "record type not allowed here"
|
||
|
Index: csl/camlp4/ocaml_src/meta/pa_r.ml
|
||
|
diff -u csl/camlp4/ocaml_src/meta/pa_r.ml:1.48 csl/camlp4/ocaml_src/meta/pa_r.ml:1.50
|
||
|
--- csl/camlp4/ocaml_src/meta/pa_r.ml:1.48 Thu Sep 25 14:05:07 2003
|
||
|
+++ csl/camlp4/ocaml_src/meta/pa_r.ml Thu Oct 2 14:33:44 2003
|
||
|
@@ -1540,6 +1540,25 @@
|
||
|
Gramext.action
|
||
|
(fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
|
||
|
(MLast.TyArr (loc, t1, t2) : 'ctyp))];
|
||
|
+ Some "label", Some Gramext.NonA,
|
||
|
+ [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) (i : string) (loc : int * int) ->
|
||
|
+ (MLast.TyOlb (loc, i, t) : 'ctyp));
|
||
|
+ [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
|
||
|
+ (MLast.TyOlb (loc, i, t) : 'ctyp));
|
||
|
+ [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) (i : string) (loc : int * int) ->
|
||
|
+ (MLast.TyLab (loc, i, t) : 'ctyp));
|
||
|
+ [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
|
||
|
+ (MLast.TyLab (loc, i, t) : 'ctyp))];
|
||
|
None, Some Gramext.LeftA,
|
||
|
[[Gramext.Sself; Gramext.Sself],
|
||
|
Gramext.action
|
||
|
@@ -2240,27 +2259,6 @@
|
||
|
Gramext.action
|
||
|
(fun (l : 'class_longident) _ (m : string) (loc : int * int) ->
|
||
|
(m :: l : 'class_longident))]];
|
||
|
- Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
|
||
|
- Some (Gramext.After "arrow"),
|
||
|
- [None, Some Gramext.NonA,
|
||
|
- [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) (i : string) (loc : int * int) ->
|
||
|
- (MLast.TyOlb (loc, i, t) : 'ctyp));
|
||
|
- [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
|
||
|
- Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
|
||
|
- (MLast.TyOlb (loc, i, t) : 'ctyp));
|
||
|
- [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) (i : string) (loc : int * int) ->
|
||
|
- (MLast.TyLab (loc, i, t) : 'ctyp));
|
||
|
- [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
|
||
|
- Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
|
||
|
- (MLast.TyLab (loc, i, t) : 'ctyp))]];
|
||
|
Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
|
||
|
Some (Gramext.Level "simple"),
|
||
|
[None, None,
|
||
|
Index: csl/camlp4/ocaml_src/meta/q_MLast.ml
|
||
|
diff -u csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56 csl/camlp4/ocaml_src/meta/q_MLast.ml:1.58
|
||
|
--- csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56 Thu Jul 24 00:26:19 2003
|
||
|
+++ csl/camlp4/ocaml_src/meta/q_MLast.ml Thu Oct 2 14:33:44 2003
|
||
|
@@ -153,7 +153,9 @@
|
||
|
let a_STRING = Grammar.Entry.create gram "a_STRING";;
|
||
|
let a_CHAR = Grammar.Entry.create gram "a_CHAR";;
|
||
|
let a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";;
|
||
|
+let a_LABEL = Grammar.Entry.create gram "a_LABEL";;
|
||
|
let a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";;
|
||
|
+let a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";;
|
||
|
|
||
|
let o2b =
|
||
|
function
|
||
|
@@ -626,7 +628,7 @@
|
||
|
Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
|
||
|
| _ ->
|
||
|
match () with
|
||
|
- _ -> raise (Match_failure ("q_MLast.ml", 300, 19))
|
||
|
+ _ -> raise (Match_failure ("q_MLast.ml", 302, 19))
|
||
|
in
|
||
|
Qast.Node ("StExc", [Qast.Loc; c; tl; b]) :
|
||
|
'str_item));
|
||
|
@@ -896,7 +898,7 @@
|
||
|
Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
|
||
|
| _ ->
|
||
|
match () with
|
||
|
- _ -> raise (Match_failure ("q_MLast.ml", 358, 19))
|
||
|
+ _ -> raise (Match_failure ("q_MLast.ml", 360, 19))
|
||
|
in
|
||
|
Qast.Node ("SgExc", [Qast.Loc; c; tl]) :
|
||
|
'sig_item));
|
||
|
@@ -2254,6 +2256,32 @@
|
||
|
Gramext.action
|
||
|
(fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
|
||
|
(Qast.Node ("TyArr", [Qast.Loc; t1; t2]) : 'ctyp))];
|
||
|
+ Some "label", Some Gramext.NonA,
|
||
|
+ [[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) (i : 'a_OPTLABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
|
||
|
+ [Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj
|
||
|
+ (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
|
||
|
+ Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
|
||
|
+ (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
|
||
|
+ [Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) (i : 'a_LABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp));
|
||
|
+ [Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
|
||
|
+ Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
|
||
|
+ (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))];
|
||
|
None, Some Gramext.LeftA,
|
||
|
[[Gramext.Sself; Gramext.Sself],
|
||
|
Gramext.action
|
||
|
@@ -3345,22 +3373,6 @@
|
||
|
(fun (l : 'class_longident) _ (m : 'a_UIDENT) (loc : int * int) ->
|
||
|
(Qast.Cons (m, l) : 'class_longident))]];
|
||
|
Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
|
||
|
- Some (Gramext.After "arrow"),
|
||
|
- [None, Some Gramext.NonA,
|
||
|
- [[Gramext.Snterm
|
||
|
- (Grammar.Entry.obj
|
||
|
- (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
|
||
|
- Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
|
||
|
- (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
|
||
|
- [Gramext.Snterm
|
||
|
- (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
|
||
|
- Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
- Gramext.action
|
||
|
- (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
|
||
|
- (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))]];
|
||
|
- Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
|
||
|
Some (Gramext.Level "simple"),
|
||
|
[None, None,
|
||
|
[[Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
|
||
|
@@ -3518,6 +3530,30 @@
|
||
|
(fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'patt));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
|
||
|
+ Gramext.Stoken ("", "(");
|
||
|
+ Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e));
|
||
|
+ Gramext.srules
|
||
|
+ [[Gramext.Sopt
|
||
|
+ (Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
|
||
|
+ Gramext.action
|
||
|
+ (fun (a : 'eq_expr option) (loc : int * int) ->
|
||
|
+ (Qast.Option a : 'a_opt));
|
||
|
+ [Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
|
||
|
+ Gramext.action
|
||
|
+ (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
|
||
|
+ Gramext.Stoken ("", ")")],
|
||
|
+ Gramext.action
|
||
|
+ (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ (i : 'a_OPTLABEL)
|
||
|
+ (loc : int * int) ->
|
||
|
+ (Qast.Node
|
||
|
+ ("PaOlb",
|
||
|
+ [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
|
||
|
+ 'patt));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj
|
||
|
(a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");
|
||
|
@@ -3548,6 +3584,13 @@
|
||
|
(fun (i : 'a_TILDEIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'patt));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (p : 'patt) (i : 'a_LABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
|
||
|
+ 'patt));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
Gramext.action
|
||
|
@@ -3606,6 +3649,30 @@
|
||
|
(fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
|
||
|
+ Gramext.Stoken ("", "(");
|
||
|
+ Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e));
|
||
|
+ Gramext.srules
|
||
|
+ [[Gramext.Sopt
|
||
|
+ (Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
|
||
|
+ Gramext.action
|
||
|
+ (fun (a : 'eq_expr option) (loc : int * int) ->
|
||
|
+ (Qast.Option a : 'a_opt));
|
||
|
+ [Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
|
||
|
+ Gramext.action
|
||
|
+ (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
|
||
|
+ Gramext.Stoken ("", ")")],
|
||
|
+ Gramext.action
|
||
|
+ (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ (i : 'a_OPTLABEL)
|
||
|
+ (loc : int * int) ->
|
||
|
+ (Qast.Node
|
||
|
+ ("PaOlb",
|
||
|
+ [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
|
||
|
+ 'ipatt));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj
|
||
|
(a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");
|
||
|
@@ -3636,6 +3703,13 @@
|
||
|
(fun (i : 'a_TILDEIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (p : 'ipatt) (i : 'a_LABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
|
||
|
+ 'ipatt));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
Gramext.action
|
||
|
@@ -3669,6 +3743,13 @@
|
||
|
(fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (e : 'expr) (i : 'a_OPTLABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) :
|
||
|
+ 'expr));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj
|
||
|
(a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
@@ -3682,6 +3763,13 @@
|
||
|
(fun (i : 'a_TILDEIDENT) (loc : int * int) ->
|
||
|
(Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option None]) : 'expr));
|
||
|
[Gramext.Snterm
|
||
|
+ (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
|
||
|
+ Gramext.Sself],
|
||
|
+ Gramext.action
|
||
|
+ (fun (e : 'expr) (i : 'a_LABEL) (loc : int * int) ->
|
||
|
+ (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) :
|
||
|
+ 'expr));
|
||
|
+ [Gramext.Snterm
|
||
|
(Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
|
||
|
Gramext.Stoken ("", ":"); Gramext.Sself],
|
||
|
Gramext.action
|
||
|
@@ -4427,6 +4515,11 @@
|
||
|
Gramext.action
|
||
|
(fun (a : string) _ (loc : int * int) ->
|
||
|
(antiquot "" loc a : 'a_TILDEIDENT))]];
|
||
|
+ Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e), None,
|
||
|
+ [None, None,
|
||
|
+ [[Gramext.Stoken ("LABEL", "")],
|
||
|
+ Gramext.action
|
||
|
+ (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_LABEL))]];
|
||
|
Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e),
|
||
|
None,
|
||
|
[None, None,
|
||
|
@@ -4437,7 +4530,12 @@
|
||
|
[Gramext.Stoken ("", "?"); Gramext.Stoken ("ANTIQUOT", "")],
|
||
|
Gramext.action
|
||
|
(fun (a : string) _ (loc : int * int) ->
|
||
|
- (antiquot "" loc a : 'a_QUESTIONIDENT))]]];;
|
||
|
+ (antiquot "" loc a : 'a_QUESTIONIDENT))]];
|
||
|
+ Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e), None,
|
||
|
+ [None, None,
|
||
|
+ [[Gramext.Stoken ("OPTLABEL", "")],
|
||
|
+ Gramext.action
|
||
|
+ (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_OPTLABEL))]]];;
|
||
|
|
||
|
let apply_entry e =
|
||
|
let f s = Grammar.Entry.parse e (Stream.of_string s) in
|
||
|
Index: csl/emacs/Makefile
|
||
|
diff -u csl/emacs/Makefile:1.15 csl/emacs/Makefile:1.16
|
||
|
--- csl/emacs/Makefile:1.15 Fri Aug 29 17:38:28 2003
|
||
|
+++ csl/emacs/Makefile Fri Oct 10 15:25:38 2003
|
||
|
@@ -1,4 +1,4 @@
|
||
|
-# $Id: Makefile,v 1.15 2003/08/29 15:38:28 doligez Exp $
|
||
|
+# $Id: Makefile,v 1.16 2003/10/10 13:25:38 remy Exp $
|
||
|
|
||
|
include ../config/Makefile
|
||
|
|
||
|
@@ -24,6 +24,7 @@
|
||
|
(byte-compile-file "caml.el") \
|
||
|
(byte-compile-file "inf-caml.el") \
|
||
|
(byte-compile-file "caml-help.el") \
|
||
|
+ (byte-compile-file "caml-types.el") \
|
||
|
(byte-compile-file "camldebug.el"))
|
||
|
|
||
|
install:
|
||
|
Index: csl/emacs/caml-emacs.el
|
||
|
diff -u csl/emacs/caml-emacs.el:1.4 csl/emacs/caml-emacs.el:1.5
|
||
|
--- csl/emacs/caml-emacs.el:1.4 Mon Aug 25 17:01:20 2003
|
||
|
+++ csl/emacs/caml-emacs.el Fri Oct 10 15:25:38 2003
|
||
|
@@ -8,7 +8,7 @@
|
||
|
(defun caml-event-window (e) (posn-window (event-start e)))
|
||
|
(defun caml-event-point-start (e) (posn-point (event-start e)))
|
||
|
(defun caml-event-point-end (e) (posn-point (event-end e)))
|
||
|
-(defalias 'caml-track-mouse 'track-mouse)
|
||
|
(defalias 'caml-read-event 'read-event)
|
||
|
+(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body))
|
||
|
|
||
|
(provide 'caml-emacs)
|
||
|
Index: csl/emacs/caml-types.el
|
||
|
diff -u csl/emacs/caml-types.el:1.24 csl/emacs/caml-types.el:1.26
|
||
|
--- csl/emacs/caml-types.el:1.24 Fri Sep 5 20:01:46 2003
|
||
|
+++ csl/emacs/caml-types.el Sat Oct 11 02:00:14 2003
|
||
|
@@ -10,7 +10,7 @@
|
||
|
;(* *)
|
||
|
;(***********************************************************************)
|
||
|
|
||
|
-;(* $Id: caml-types.el,v 1.24 2003/09/05 18:01:46 remy Exp $ *)
|
||
|
+;(* $Id: caml-types.el,v 1.26 2003/10/11 00:00:14 doligez Exp $ *)
|
||
|
|
||
|
; An emacs-lisp complement to the "-dtypes" option of ocamlc and ocamlopt.
|
||
|
|
||
|
@@ -21,6 +21,8 @@
|
||
|
(require 'caml-xemacs)
|
||
|
(require 'caml-emacs)))
|
||
|
|
||
|
+
|
||
|
+
|
||
|
(defvar caml-types-location-re nil "Regexp to parse *.annot files.
|
||
|
|
||
|
Annotation files *.annot may be generated with the \"-dtypes\" option
|
||
|
@@ -160,8 +162,10 @@
|
||
|
(target-file (file-name-nondirectory (buffer-file-name)))
|
||
|
(target-date (nth 5 (file-attributes target-file))))
|
||
|
(unless (and caml-types-annotation-tree
|
||
|
+ type-date
|
||
|
+ caml-types-annotation-date
|
||
|
(not (caml-types-date< caml-types-annotation-date type-date)))
|
||
|
- (if (caml-types-date< type-date target-date)
|
||
|
+ (if (and type-date target-date (caml-types-date< type-date target-date))
|
||
|
(error (format "%s is more recent than %s" target-file type-file)))
|
||
|
(message "Reading annotation file...")
|
||
|
(let* ((type-buf (caml-types-find-file type-file))
|
||
|
@@ -376,10 +380,13 @@
|
||
|
(with-current-buffer buf (toggle-read-only 1))
|
||
|
)
|
||
|
(t
|
||
|
- (error "No annotation file. You may compile with \"-dtypes\" option"))
|
||
|
+ (error "No annotation file. You should compile with option \"-dtypes\"."))
|
||
|
)
|
||
|
buf))
|
||
|
|
||
|
+(defun caml-types-mouse-ignore (event)
|
||
|
+ (interactive "e")
|
||
|
+ nil)
|
||
|
|
||
|
(defun caml-types-explore (event)
|
||
|
"Explore type annotations by mouse dragging.
|
||
|
@@ -395,58 +402,79 @@
|
||
|
(target-line) (target-bol)
|
||
|
target-pos
|
||
|
Left Right limits cnum node mes type
|
||
|
- (tree caml-types-annotation-tree)
|
||
|
region
|
||
|
+ target-tree
|
||
|
)
|
||
|
- (caml-types-preprocess type-file)
|
||
|
- (unless caml-types-buffer
|
||
|
- (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)))
|
||
|
- ;; (message "Drag the mouse to explore types")
|
||
|
(unwind-protect
|
||
|
- (caml-track-mouse
|
||
|
- (setq region
|
||
|
- (caml-types-typed-make-overlay target-buf
|
||
|
- (caml-event-point-start event)))
|
||
|
- (while (and event
|
||
|
- (integer-or-marker-p
|
||
|
- (setq cnum (caml-event-point-end event))))
|
||
|
- (if (and region (<= (car region) cnum) (<= cnum (cdr region)))
|
||
|
- (if (and limits (>= cnum (car limits)) (< cnum (cdr limits)))
|
||
|
- (message mes)
|
||
|
- (setq target-bol
|
||
|
- (save-excursion (goto-char cnum)
|
||
|
- (caml-line-beginning-position)))
|
||
|
- (setq target-line
|
||
|
- (1+ (count-lines (point-min) target-bol)))
|
||
|
- (setq target-pos (vector target-file target-line target-bol cnum))
|
||
|
- (save-excursion
|
||
|
- (setq node (caml-types-find-location target-pos () tree))
|
||
|
- (set-buffer caml-types-buffer)
|
||
|
- (erase-buffer)
|
||
|
- (cond
|
||
|
- (node
|
||
|
- (setq Left (caml-types-get-pos target-buf (elt node 0)))
|
||
|
- (setq Right (caml-types-get-pos target-buf (elt node 1)))
|
||
|
- (move-overlay caml-types-expr-ovl Left Right target-buf)
|
||
|
- (setq limits (caml-types-find-interval target-buf target-pos
|
||
|
- node))
|
||
|
- (setq type (elt node 2))
|
||
|
- )
|
||
|
- (t
|
||
|
- (delete-overlay caml-types-expr-ovl)
|
||
|
- (setq type "*no type information*")
|
||
|
- (setq limits (caml-types-find-interval target-buf target-pos
|
||
|
- tree))
|
||
|
- ))
|
||
|
- (message (setq mes (format "type: %s" type)))
|
||
|
- (insert type)
|
||
|
- )))
|
||
|
- (setq event (caml-read-event))
|
||
|
- (unless (mouse-movement-p event) (setq event nil))
|
||
|
- )
|
||
|
- )
|
||
|
- (delete-overlay caml-types-expr-ovl)
|
||
|
- (delete-overlay caml-types-typed-ovl)
|
||
|
+ (progn
|
||
|
+ (caml-types-preprocess type-file)
|
||
|
+ (setq target-tree caml-types-annotation-tree)
|
||
|
+ (unless caml-types-buffer
|
||
|
+ (setq caml-types-buffer
|
||
|
+ (get-buffer-create caml-types-buffer-name)))
|
||
|
+ ;; (message "Drag the mouse to explore types")
|
||
|
+ (unwind-protect
|
||
|
+ (caml-track-mouse
|
||
|
+ (setq region
|
||
|
+ (caml-types-typed-make-overlay
|
||
|
+ target-buf (caml-event-point-start event)))
|
||
|
+ (while (and event
|
||
|
+ (integer-or-marker-p
|
||
|
+ (setq cnum (caml-event-point-end event))))
|
||
|
+ (if (and region (<= (car region) cnum) (< cnum (cdr region)))
|
||
|
+ (if (and limits
|
||
|
+ (>= cnum (car limits)) (< cnum (cdr limits)))
|
||
|
+ (message mes)
|
||
|
+ (setq target-bol
|
||
|
+ (save-excursion
|
||
|
+ (goto-char cnum) (caml-line-beginning-position))
|
||
|
+ target-line (1+ (count-lines (point-min)
|
||
|
+ target-bol))
|
||
|
+ target-pos
|
||
|
+ (vector target-file target-line target-bol cnum))
|
||
|
+ (save-excursion
|
||
|
+ (setq node (caml-types-find-location
|
||
|
+ target-pos () target-tree))
|
||
|
+ (set-buffer caml-types-buffer)
|
||
|
+ (erase-buffer)
|
||
|
+ (cond
|
||
|
+ (node
|
||
|
+ (setq Left
|
||
|
+ (caml-types-get-pos target-buf (elt node 0))
|
||
|
+ Right
|
||
|
+ (caml-types-get-pos target-buf (elt node 1)))
|
||
|
+ (move-overlay
|
||
|
+ caml-types-expr-ovl Left Right target-buf)
|
||
|
+ (setq limits
|
||
|
+ (caml-types-find-interval target-buf
|
||
|
+ target-pos node)
|
||
|
+ type (elt node 2))
|
||
|
+ )
|
||
|
+ (t
|
||
|
+ (delete-overlay caml-types-expr-ovl)
|
||
|
+ (setq type "*no type information*")
|
||
|
+ (setq limits
|
||
|
+ (caml-types-find-interval
|
||
|
+ target-buf target-pos target-tree))
|
||
|
+ ))
|
||
|
+ (message (setq mes (format "type: %s" type)))
|
||
|
+ (insert type)
|
||
|
+ )))
|
||
|
+ (setq event (caml-read-event))
|
||
|
+ (unless (mouse-movement-p event) (setq event nil))
|
||
|
+ )
|
||
|
+ )
|
||
|
+ (delete-overlay caml-types-expr-ovl)
|
||
|
+ (delete-overlay caml-types-typed-ovl)
|
||
|
+ ))
|
||
|
+ ;; the mouse is down. One should prevent against mouse release,
|
||
|
+ ;; which could do something undesirable.
|
||
|
+ ;; In most common cases, next event will be mouse release.
|
||
|
+ ;; However, it could also be a key stroke before mouse release.
|
||
|
+ ;; Will then execute the action for mouse release (if bound).
|
||
|
+ ;; Emacs does not allow to test whether mouse is up or down.
|
||
|
+ ;; Same problem may happen above while exploring
|
||
|
+ (if (and event (caml-read-event)))
|
||
|
)))
|
||
|
|
||
|
(defun caml-types-typed-make-overlay (target-buf pos)
|
||
|
@@ -459,7 +487,7 @@
|
||
|
(if (and (equal target-buf (current-buffer))
|
||
|
(setq left (caml-types-get-pos target-buf (elt node 0))
|
||
|
right (caml-types-get-pos target-buf (elt node 1)))
|
||
|
- (<= left pos) (>= right pos)
|
||
|
+ (<= left pos) (> right pos)
|
||
|
)
|
||
|
(setq start (min start left)
|
||
|
end (max end right))
|
||
|
Index: csl/emacs/caml-xemacs.el
|
||
|
diff -u csl/emacs/caml-xemacs.el:1.3 csl/emacs/caml-xemacs.el:1.4
|
||
|
--- csl/emacs/caml-xemacs.el:1.3 Tue Jul 29 09:30:03 2003
|
||
|
+++ csl/emacs/caml-xemacs.el Fri Oct 10 15:25:38 2003
|
||
|
@@ -12,8 +12,9 @@
|
||
|
(defun caml-event-window (e) (event-window e))
|
||
|
(defun caml-event-point-start (e) (event-closest-point e))
|
||
|
(defun caml-event-point-end (e) (event-closest-point e))
|
||
|
-(defalias 'caml-track-mouse 'progn)
|
||
|
(defalias 'caml-read-event 'next-event)
|
||
|
+(defmacro caml-track-mouse (&rest body) (cons 'progn body))
|
||
|
+
|
||
|
(defun mouse-movement-p (e) (equal (event-type e) 'motion))
|
||
|
|
||
|
(provide 'caml-xemacs)
|
||
|
Index: csl/emacs/caml.el
|
||
|
diff -u csl/emacs/caml.el:1.34 csl/emacs/caml.el:1.35
|
||
|
--- csl/emacs/caml.el:1.34 Mon Jul 28 20:06:49 2003
|
||
|
+++ csl/emacs/caml.el Fri Oct 10 15:25:38 2003
|
||
|
@@ -283,6 +283,8 @@
|
||
|
|
||
|
;; caml-types
|
||
|
(define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type)
|
||
|
+ ;; to prevent misbehavior in case of error during exploration.
|
||
|
+ (define-key caml-mode-map [mouse-2] 'caml-types-mouse-ignore)
|
||
|
(define-key caml-mode-map [down-mouse-2] 'caml-types-explore)
|
||
|
;; caml-help
|
||
|
(define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)
|
||
|
Index: csl/otherlibs/threads/scheduler.c
|
||
|
diff -u csl/otherlibs/threads/scheduler.c:1.56 csl/otherlibs/threads/scheduler.c:1.57
|
||
|
--- csl/otherlibs/threads/scheduler.c:1.56 Thu Mar 20 17:23:03 2003
|
||
|
+++ csl/otherlibs/threads/scheduler.c Fri Oct 10 15:13:21 2003
|
||
|
@@ -11,7 +11,7 @@
|
||
|
/* */
|
||
|
/***********************************************************************/
|
||
|
|
||
|
-/* $Id: scheduler.c,v 1.56 2003/03/20 16:23:03 xleroy Exp $ */
|
||
|
+/* $Id: scheduler.c,v 1.57 2003/10/10 13:13:21 doligez Exp $ */
|
||
|
|
||
|
/* The thread scheduler */
|
||
|
|
||
|
@@ -72,10 +72,10 @@
|
||
|
|
||
|
/* The thread descriptors */
|
||
|
|
||
|
-struct thread_struct {
|
||
|
+struct caml_thread_struct {
|
||
|
value ident; /* Unique id (for equality comparisons) */
|
||
|
- struct thread_struct * next; /* Double linking of threads */
|
||
|
- struct thread_struct * prev;
|
||
|
+ struct caml_thread_struct * next; /* Double linking of threads */
|
||
|
+ struct caml_thread_struct * prev;
|
||
|
value * stack_low; /* The execution stack for this thread */
|
||
|
value * stack_high;
|
||
|
value * stack_threshold;
|
||
|
@@ -94,7 +94,7 @@
|
||
|
value retval; /* Value to return when thread resumes */
|
||
|
};
|
||
|
|
||
|
-typedef struct thread_struct * thread_t;
|
||
|
+typedef struct caml_thread_struct * caml_thread_t;
|
||
|
|
||
|
#define RUNNABLE Val_int(0)
|
||
|
#define KILLED Val_int(1)
|
||
|
@@ -122,7 +122,7 @@
|
||
|
#define DELAY_INFTY 1E30 /* +infty, for this purpose */
|
||
|
|
||
|
/* The thread currently active */
|
||
|
-static thread_t curr_thread = NULL;
|
||
|
+static caml_thread_t curr_thread = NULL;
|
||
|
/* Identifier for next thread creation */
|
||
|
static value next_ident = Val_int(0);
|
||
|
|
||
|
@@ -134,7 +134,7 @@
|
||
|
|
||
|
static void thread_scan_roots(scanning_action action)
|
||
|
{
|
||
|
- thread_t th, start;
|
||
|
+ caml_thread_t th, start;
|
||
|
|
||
|
/* Scan all active descriptors */
|
||
|
start = curr_thread;
|
||
|
@@ -161,7 +161,8 @@
|
||
|
if (curr_thread != NULL) return Val_unit;
|
||
|
/* Create a descriptor for the current thread */
|
||
|
curr_thread =
|
||
|
- (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0);
|
||
|
+ (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct)
|
||
|
+ / sizeof(value), 0);
|
||
|
curr_thread->ident = next_ident;
|
||
|
next_ident = Val_int(Int_val(next_ident) + 1);
|
||
|
curr_thread->next = curr_thread;
|
||
|
@@ -218,10 +219,11 @@
|
||
|
|
||
|
value thread_new(value clos) /* ML */
|
||
|
{
|
||
|
- thread_t th;
|
||
|
+ caml_thread_t th;
|
||
|
/* Allocate the thread and its stack */
|
||
|
Begin_root(clos);
|
||
|
- th = (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0);
|
||
|
+ th = (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct)
|
||
|
+ / sizeof(value), 0);
|
||
|
End_roots();
|
||
|
th->ident = next_ident;
|
||
|
next_ident = Val_int(Int_val(next_ident) + 1);
|
||
|
@@ -268,7 +270,7 @@
|
||
|
|
||
|
value thread_id(value th) /* ML */
|
||
|
{
|
||
|
- return ((struct thread_struct *)th)->ident;
|
||
|
+ return ((caml_thread_t)th)->ident;
|
||
|
}
|
||
|
|
||
|
/* Return the current time as a floating-point number */
|
||
|
@@ -293,7 +295,7 @@
|
||
|
|
||
|
static value schedule_thread(void)
|
||
|
{
|
||
|
- thread_t run_thread, th;
|
||
|
+ caml_thread_t run_thread, th;
|
||
|
fd_set readfds, writefds, exceptfds;
|
||
|
double delay, now;
|
||
|
int need_select, need_wait;
|
||
|
@@ -353,7 +355,7 @@
|
||
|
}
|
||
|
}
|
||
|
if (th->status & (BLOCKED_JOIN - 1)) {
|
||
|
- if (((thread_t)(th->joining))->status == KILLED) {
|
||
|
+ if (((caml_thread_t)(th->joining))->status == KILLED) {
|
||
|
th->status = RUNNABLE;
|
||
|
Assign(th->retval, RESUMED_JOIN);
|
||
|
}
|
||
|
@@ -682,7 +684,7 @@
|
||
|
{
|
||
|
check_callback();
|
||
|
Assert(curr_thread != NULL);
|
||
|
- if (((thread_t)th)->status == KILLED) return Val_unit;
|
||
|
+ if (((caml_thread_t)th)->status == KILLED) return Val_unit;
|
||
|
curr_thread->status = BLOCKED_JOIN;
|
||
|
Assign(curr_thread->joining, th);
|
||
|
return schedule_thread();
|
||
|
@@ -703,7 +705,7 @@
|
||
|
|
||
|
value thread_wakeup(value thread) /* ML */
|
||
|
{
|
||
|
- thread_t th = (thread_t) thread;
|
||
|
+ caml_thread_t th = (caml_thread_t) thread;
|
||
|
switch (th->status) {
|
||
|
case SUSPENDED:
|
||
|
th->status = RUNNABLE;
|
||
|
@@ -730,7 +732,7 @@
|
||
|
value thread_kill(value thread) /* ML */
|
||
|
{
|
||
|
value retval = Val_unit;
|
||
|
- thread_t th = (thread_t) thread;
|
||
|
+ caml_thread_t th = (caml_thread_t) thread;
|
||
|
if (th->status == KILLED) failwith("Thread.kill: killed thread");
|
||
|
/* Don't paint ourselves in a corner */
|
||
|
if (th == th->next) failwith("Thread.kill: cannot kill the last thread");
|
||
|
@@ -740,7 +742,7 @@
|
||
|
if (th == curr_thread) {
|
||
|
Begin_root(thread);
|
||
|
retval = schedule_thread();
|
||
|
- th = (thread_t) thread;
|
||
|
+ th = (caml_thread_t) thread;
|
||
|
End_roots();
|
||
|
}
|
||
|
/* Remove thread from the doubly-linked list */
|
||
|
Index: csl/stdlib/buffer.mli
|
||
|
diff -u csl/stdlib/buffer.mli:1.16 csl/stdlib/buffer.mli:1.17
|
||
|
--- csl/stdlib/buffer.mli:1.16 Wed May 14 19:52:19 2003
|
||
|
+++ csl/stdlib/buffer.mli Wed Oct 8 15:12:44 2003
|
||
|
@@ -74,7 +74,7 @@
|
||
|
- a non empty sequence of alphanumeric or [_] characters,
|
||
|
- an arbitrary sequence of characters enclosed by a pair of
|
||
|
matching parentheses or curly brackets.
|
||
|
- An escaped [$] character is a [$] that immediately folows a backslash
|
||
|
+ An escaped [$] character is a [$] that immediately follows a backslash
|
||
|
character; it then stands for a plain [$].
|
||
|
Raise [Not_found] if the closing character of a parenthesized variable
|
||
|
cannot be found. *)
|
||
|
Index: csl/stdlib/pervasives.mli
|
||
|
diff -u csl/stdlib/pervasives.mli:1.93 csl/stdlib/pervasives.mli:1.94
|
||
|
--- csl/stdlib/pervasives.mli:1.93 Thu Sep 4 14:44:48 2003
|
||
|
+++ csl/stdlib/pervasives.mli Wed Oct 8 15:13:33 2003
|
||
|
@@ -11,7 +11,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: pervasives.mli,v 1.93 2003/09/04 12:44:48 doligez Exp $ *)
|
||
|
+(* $Id: pervasives.mli,v 1.94 2003/10/08 13:13:33 weis Exp $ *)
|
||
|
|
||
|
(** The initially opened module.
|
||
|
|
||
|
@@ -800,7 +800,7 @@
|
||
|
|
||
|
external string_of_format :
|
||
|
('a, 'b, 'c, 'd) format4 -> string = "%identity"
|
||
|
-(** Converts a format string into a string.*)
|
||
|
+(** Converts a format string into a string. *)
|
||
|
external format_of_string :
|
||
|
('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity"
|
||
|
(** [format_of_string s] returns a format string read from the string
|
||
|
Index: csl/stdlib/sys.ml
|
||
|
diff -u csl/stdlib/sys.ml:1.78 csl/stdlib/sys.ml:1.80
|
||
|
--- csl/stdlib/sys.ml:1.78 Fri Sep 12 09:46:23 2003
|
||
|
+++ csl/stdlib/sys.ml Mon Oct 13 09:39:46 2003
|
||
|
@@ -11,7 +11,7 @@
|
||
|
(* *)
|
||
|
(***********************************************************************)
|
||
|
|
||
|
-(* $Id: sys.ml,v 1.78 2003/09/12 07:46:23 xleroy Exp $ *)
|
||
|
+(* $Id: sys.ml,v 1.80 2003/10/13 07:39:46 xleroy Exp $ *)
|
||
|
|
||
|
(* System interface *)
|
||
|
|
||
|
@@ -78,4 +78,4 @@
|
||
|
|
||
|
(* OCaml version string, must be in the format described in sys.mli. *)
|
||
|
|
||
|
-let ocaml_version = "3.07";;
|
||
|
+let ocaml_version = "3.07+2";;
|