Commit c27e18523583b596a52c9048dceff98d915ed78c - labltk

+17

-0

Changes less more

	0	2022-11-01:
	1	-----------
	2	* Release labltk-8.06.13 for OCaml 5.0
	3
	4	2022-10-13:
	5	-----------
	6	* Fix compatibility with OCaml 5.0
	7
	8	2022-10-06:
	9	-----------
	10	* Update OCamlBrowser for OCaml 5.0
	11
	12	2022-03-30:
	13	-----------
	14	* Release labltk-8.06.12 for OCaml 4.14
	15	* Update OCamlBrowser
	16
0	17	2021-09-17:
1	18	-----------
2	19	* Release labltk-8.06.11 for ocaml 4.13

+1

-1

INSTALL less more

2	2
3	3	PREREQUISITES
4	4
5		* OCaml (>= 4.08) should be installed (4.13 for ocamlbrowser)
	5	* OCaml (>= 4.08) should be installed (5.0 for ocamlbrowser)
6	6
7	7	* Tcl/Tk (>= 8.03) should be installed
8	8

+2

-2

browser/Makefile.shared less more

13	13	# #
14	14	#########################################################################
15	15
16		LABLTKLIB=-I ../labltk -I ../lib -I ../support -I +compiler-libs
17		INCLUDES=$(LABLTKLIB)
	16	LABLTKLIB=-I ../labltk -I ../lib -I ../support -I +compiler-libs -I +str -I +unix
	17	INCLUDES=$(LABLTKLIB) -I +unix -I +str
18	18
19	19	OBJ = list2.cmo useunix.cmo setpath.cmo lexical.cmo \
20	20	fileselect.cmo searchid.cmo searchpos.cmo \

+1

-3

browser/main.ml less more

82	82	"<command> Pipe sources through preprocessor <command>";
83	83	"-rectypes", Arg.Set Clflags.recursive_types,
84	84	" Allow arbitrary recursive types";
85		"-safe-string", Arg.Clear Clflags.unsafe_string,
86		" Make strings immutable";
87	85	"-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types";
88	86	"-version", Arg.Unit print_version,
89	87	" Print version and exit";

95	93	Arg.parse spec
96	94	(fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
97	95	errmsg;
98		Load_path.init
	96	Load_path.init ~auto_include:Load_path.no_auto_include
99	97	(Sys.getcwd ()
100	98	:: List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
101	99	@ [Config.standard_library]);

+14

-17

browser/searchid.ml less more

94	94	if p = 0 then 1 else n * arr (p-1) ~card:(n-1)
95	95
96	96	let rec all_args ty =
97		let ty = repr ty in
98		match ty.desc with
	97	match get_desc ty with
99	98	Tarrow(l, ty1, ty2, _) -> let (tl,ty) = all_args ty2 in ((l,ty1)::tl, ty)
100	99	\| _ -> ([], ty)
101	100
102	101	let rec equal ~prefix t1 t2 =
103		match (repr t1).desc, (repr t2).desc with
	102	match get_desc t1, get_desc t2 with
104	103	Tvar _, Tvar _ -> true
105	104	\| Tvariant row1, Tvariant row2 ->
106		let row1 = row_repr row1 and row2 = row_repr row2 in
107		let fields1 = filter_row_fields false row1.row_fields
108		and fields2 = filter_row_fields false row1.row_fields
	105	let fields1 = filter_row_fields false (row_fields row1)
	106	and fields2 = filter_row_fields false (row_fields row1)
109	107	in
110	108	let r1, r2, pairs = merge_row_fields fields1 fields2 in
111		row1.row_closed = row2.row_closed && r1 = [] && r2 = [] &&
	109	row_closed row1 = row_closed row2 && r1 = [] && r2 = [] &&
112	110	List.for_all pairs ~f:
113	111	begin fun (_,f1,f2) ->
114	112	match row_field_repr f1, row_field_repr f2 with
115	113	Rpresent None, Rpresent None -> true
116	114	\| Rpresent(Some t1), Rpresent (Some t2) -> equal t1 t2 ~prefix
117		\| Reither(c1, tl1, _, _), Reither(c2, tl2, _, _) ->
	115	\| Reither(c1, tl1, _), Reither(c2, tl2, _) ->
118	116	c1 = c2 && List.length tl1 = List.length tl2 &&
119	117	List.for_all2 tl1 tl2 ~f:(equal ~prefix)
120	118	\| _ -> false

142	140	let get_options = List.filter ~f:Btype.is_optional
143	141
144	142	let rec included ~prefix t1 t2 =
145		match (repr t1).desc, (repr t2).desc with
	143	match get_desc t1, get_desc t2 with
146	144	Tvar _, _ -> true
147	145	\| Tvariant row1, Tvariant row2 ->
148		let row1 = row_repr row1 and row2 = row_repr row2 in
149		let fields1 = filter_row_fields false row1.row_fields
150		and fields2 = filter_row_fields false row2.row_fields
	146	let fields1 = filter_row_fields false (row_fields row1)
	147	and fields2 = filter_row_fields false (row_fields row2)
151	148	in
152	149	let r1, r2, pairs = merge_row_fields fields1 fields2 in
153	150	r1 = [] &&

156	153	match row_field_repr f1, row_field_repr f2 with
157	154	Rpresent None, Rpresent None -> true
158	155	\| Rpresent(Some t1), Rpresent (Some t2) -> included t1 t2 ~prefix
159		\| Reither(c1, tl1, _, _), Reither(c2, tl2, _, _) ->
	156	\| Reither(c1, tl1, _), Reither(c2, tl2, _) ->
160	157	c1 = c2 && List.length tl1 = List.length tl2 &&
161	158	List.for_all2 tl1 tl2 ~f:(included ~prefix)
162	159	\| _ -> false

206	203	let get_fields ~prefix ~sign self =
207	204	(let env = open_signature Fresh (mkpath prefix) sign !start_env in)
208	205	let env = add_signature sign !start_env in
209		match (expand_head env self).desc with
	206	match get_desc (expand_head env self) with
210	207	Tobject (ty_obj, _) ->
211	208	let l,_ = flatten_fields ty_obj in l
212	209	\| _ -> []

269	266	end
270	267
271	268	let search_all_types t ~mode =
272		let tl = match mode, t.desc with
	269	let tl = match mode, get_desc t with
273	270	`Exact, _ -> [t]
274	271	\| `Included, Tarrow _ -> [t]
275	272	\| `Included, _ ->
276		[t; newty(Tarrow(Nolabel,t,newvar(),Cok));
277		newty(Tarrow(Nolabel,newvar(),t,Cok))]
	273	[t; newty(Tarrow(Nolabel,t,newvar(),commu_ok));
	274	newty(Tarrow(Nolabel,newvar(),t,commu_ok))]
278	275	in List2.flat_map !module_list ~f:
279	276	begin fun modname ->
280	277	let mlid = Lident modname in

+12

-10

browser/searchpos.ml less more

194	194
195	195	let search_pos_extension ext ~pos ~env =
196	196	begin match ext.pext_kind with
197		Pext_decl (l, _) -> search_pos_arguments l ~pos ~env
	197	Pext_decl (_, l, _) -> search_pos_arguments l ~pos ~env
198	198	\| Pext_rebind _ -> ()
199	199	end
200	200

501	501	and view_type_decl path ~env =
502	502	let td = find_type path env in
503	503	try match td.type_manifest with None -> raise Not_found
504		\| Some ty -> match (Ctype.repr ty).desc with
	504	\| Some ty -> match get_desc ty with
505	505	Tobject _ ->
506	506	let clt = find_cltype path env in
507	507	view_signature_item ~path ~env
508	508	[Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first,
509	509	Exported);
510	510	dummy_item; dummy_item]
511		\| Tvariant ({row_name = Some _} as row) ->
512		let td = {td with type_manifest = Some(
513		Btype.newgenty (Tvariant {row with row_name = None}))} in
	511	\| Tvariant row when row_name row <> None ->
	512	let Row {fields; more; closed; fixed} = row_repr row in
	513	let row = create_row ~fields ~more ~closed ~fixed ~name:None in
	514	let td =
	515	{td with type_manifest = Some(Btype.newgenty (Tvariant row))} in
514	516	view_signature_item ~path ~env
515	517	[Sig_type(ident_of_path path ~default:"t", td, Trec_first,
516	518	Exported)]

696	698	Format.set_formatter_output_functions buf#out ignore;
697	699	Format.set_margin 60;
698	700	Format.open_hbox ();
699		Printtyp.reset ();
700		Printtyp.mark_loops ty;
	701	Printtyp.prepare_for_printing [ty];
701	702	Printtyp.wrap_printing_env ~error:false env
702	703	(fun () -> Printtyp.type_expr Format.std_formatter ty);
703	704	Format.close_box (); Format.print_flush ();

711	712	in
712	713	(* Menu.add_separator menu; *)
713	714	List.iter l ~f:
714		begin fun label -> match (Ctype.repr ty).desc with
	715	begin fun label -> match get_desc ty with
715	716	Tconstr (path,_,_) ->
716	717	Menu.add_command menu ~label ~font
717	718	~command:(fun () -> view_type_decl path ~env)
718		\| Tvariant {row_name = Some (path, _)} ->
	719	\| Tvariant row when row_name row <> None ->
	720	let path, _ = Stdlib.Option.get (row_name row) in
719	721	Menu.add_command menu ~label ~font
720	722	~command:(fun () -> view_type_decl path ~env)
721	723	\| _ ->

863	865	search_pos_expr a ~pos; search_pos_expr b ~pos
864	866	\| Texp_for (_, _, a, b, _, c) ->
865	867	List.iter [a;b;c] ~f:(search_pos_expr ~pos)
866		\| Texp_send (exp, _, _) -> search_pos_expr exp ~pos
	868	\| Texp_send (exp, _) -> search_pos_expr exp ~pos
867	869	\| Texp_new (path, _, _) ->
868	870	add_found_str (`Exp(`New path, exp.exp_type))
869	871	~env:exp.exp_env ~loc:exp.exp_loc

+1

-1

browser/setpath.ml less more

30	30	end
31	31
32	32	let set_load_path l =
33		Load_path.init l;
	33	Load_path.init l ~auto_include:Load_path.no_auto_include;
34	34	exec_update_hooks ();
35	35	Env.reset_cache ()
36	36

+1

-1

browser/shell.ml less more

44	44	let obj = Obj.repr h in
45	45	if Obj.is_int obj \|\| Obj.tag obj <> Obj.custom_tag then
46	46	invalid_arg "Shell.dump_handle";
47		Nativeint.format "%x" (Obj.obj obj)
	47	Printf.sprintf "%nx" (Obj.obj obj)
48	48
49	49	(* The shell class. Now encapsulated *)
50	50

+1

-1

browser/typecheck.ml less more

115	115	List.iter psl ~f:
116	116	begin function
117	117	Ptop_def pstr ->
118		let str, sign, _names, env' = Typemod.type_structure !env pstr in
	118	let str, sign, _names, _, env' = Typemod.type_structure !env pstr in
119	119	txt.structure <- txt.structure @ str.str_items;
120	120	txt.signature <- txt.signature @ sign;
121	121	env := env'

+2

-2

browser/viewer.ml less more

64	64	[Sig_value (Ident.create_local name, vd, Exported)]
65	65	\| Ptype -> view_type_id id ~env
66	66	\| Plabel -> let ld = find_label_by_name id env in
67		begin match ld.lbl_res.desc with
	67	begin match get_desc ld.lbl_res with
68	68	Tconstr (path, _, _) -> view_type_decl path ~env
69	69	\| _ -> ()
70	70	end
71	71	\| Pconstructor ->
72	72	let cd = find_constructor_by_name id env in
73		begin match cd.cstr_tag, cd.cstr_res.desc with
	73	begin match cd.cstr_tag, get_desc cd.cstr_res with
74	74	Cstr_extension _, Tconstr (cpath, args, _) ->
75	75	view_signature ~title:(string_of_longident id) ~env ?path
76	76	[Sig_typext (Ident.create_local name,

+1

-1

camltk/Makefile less more

15	15
16	16	include ../support/Makefile.common
17	17
18		COMPFLAGS= -I ../support -no-alias-deps
	18	COMPFLAGS= -I ../support -no-alias-deps -I +unix
19	19
20	20	all: camltkobjs
21	21

+3

-2

examples_camltk/Makefile less more

16	16	include ../support/Makefile.common
17	17
18	18	# We are using the non-installed library !
19		BYT_COMPFLAGS=-I ../lib -I ../camltk -I ../support -w s -dllpath ../support
20		BIN_COMPFLAGS=-I ../lib -I ../camltk -I ../support -w s
	19	BYT_COMPFLAGS=-I ../lib -I ../camltk -I ../support -w s -dllpath ../support \
	20	-I +unix
	21	BIN_COMPFLAGS=-I ../lib -I ../camltk -I ../support -w s -I +unix
21	22
22	23	WITH_BYT_CAMLTK=labltk.cma camltk.cmo
23	24	WITH_BIN_CAMLTK=labltk.cmxa camltk.cmx

+3

-2

examples_labltk/Makefile less more

34	34	$(CAMLC) $(COMPFLAGS) -o calc $(LIBNAME).cma calc.cmo
35	35
36	36	clock: clock.cmo
37		$(CAMLC) $(COMPFLAGS) -o clock $(LIBNAME).cma unix.cma clock.cmo
	37	$(CAMLC) $(COMPFLAGS) -o clock $(LIBNAME).cma \
	38	-I +unix unix.cma clock.cmo
38	39
39	40	clock.opt: clock.cmx
40	41	$(CAMLOPT) $(COMPFLAGS) -o clock.opt \
41		$(LIBNAME).cmxa unix.cmxa clock.cmx
	42	$(LIBNAME).cmxa -I +unix unix.cmxa clock.cmx
42	43
43	44	tetris: tetris.cmo
44	45	$(CAMLC) $(COMPFLAGS) -o tetris $(LIBNAME).cma tetris.cmo

+1

-1

jpf/Makefile less more

15	15
16	16	include ../support/Makefile.common
17	17
18		COMPFLAGS=-I ../labltk -I ../support
	18	COMPFLAGS=-I ../labltk -I ../support -I +str -I +unix
19	19
20	20	OBJS= fileselect.cmo balloon.cmo shell.cmo jpf_font.cmo
21	21

+1

-1

labltk/Makefile less more

15	15
16	16	include ../support/Makefile.common
17	17
18		COMPFLAGS= -I ../support -no-alias-deps
	18	COMPFLAGS= -I ../support -no-alias-deps -I +unix
19	19
20	20	all: labltkobjs
21	21

+2

-3

lib/Makefile less more

66	66	$(LIBNAME)top$(EXE) : $(LIBNAME).cma ../support/lib$(LIBNAME).$(A)
67	67	$(CAMLC) -verbose -linkall -o $(LIBNAME)top$(EXE) -I ../support \
68	68	$(TOPLEVELLIBS) \
69		-I +compiler-libs unix.cma \
	69	-I +compiler-libs -I +unix -I +str unix.cma str.cma \
70	70	-I ../labltk -I ../camltk $(LIBNAME).cma \
71		str.cma \
72	71	$(TOPLEVELSTART)
73	72
74	73	$(LIBNAME): Makefile

113	112	cd $(INSTALLDIR); $(RANLIB) $(LIBNAME).$(A)
114	113	chmod 644 $(INSTALLDIR)/$(LIBNAME).cmxa
115	114	chmod 644 $(INSTALLDIR)/$(LIBNAME).$(A)
116		endif⏎
	115	endif

+1

-1

support/Makefile less more

29	29
30	30	CCFLAGS=-I$(LIBDIR)/caml $(TK_DEFS) $(SHAREDCCCOMPOPTS)
31	31
32		COMPFLAGS=
	32	COMPFLAGS=-I +unix
33	33	THFLAGS=-I +threads -I vmthreads
34	34	TKLDOPTS=$(TK_LINK:%=-ldopt "%")
35	35

+3

-0

support/Makefile.common less more

34	34	CAMLOPTLIBR=$(CAMLOPT) -a
35	35	MKLIB=$(BINDIR)/ocamlmklib
36	36	CAMLRUNGEN=$(BINDIR)/ocamlrun
	37	ifeq (x$(RANLIB),x)
	38	RANLIB=":"
	39	endif