diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-09-06 08:52:32 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-09-06 08:52:32 +0000 |
| commit | ea299bbbc1dcf8f0f8f3b18558145965391ad224 (patch) | |
| tree | 66a42a385bf5243f570afb2c48bf7239ce08f67a /otherlibs/labltk/compiler/tables.ml | |
| parent | bc8ff705be9af2f5883b640b1c9e285f380d5f70 (diff) | |
passage aux labels stricts
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3696 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/compiler/tables.ml')
| -rw-r--r-- | otherlibs/labltk/compiler/tables.ml | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml index f5fc1435c..85029b772 100644 --- a/otherlibs/labltk/compiler/tables.ml +++ b/otherlibs/labltk/compiler/tables.ml @@ -15,6 +15,9 @@ (* $Id$ *) +open StdLabels +open Support + (* Internal compiler errors *) exception Compiler_Error of string @@ -60,7 +63,7 @@ type fullcomponent = { } let sort_components = - Sort.list ~order:(fun c1 c2 -> c1.ml_name < c2.ml_name) + List.sort ~cmp:(fun c1 c2 -> compare c1.ml_name c2.ml_name) (* components are given either in full or abbreviated *) @@ -153,7 +156,7 @@ let new_type typname arity = subtypes = []; requires_widget_context = false; variant = false} in - Hashtbl.add types_table ~key:typname ~data:typdef; + Hashtbl'.add types_table ~key:typname ~data:typdef; typdef @@ -178,7 +181,7 @@ let declared_type_parser_arity s = (Hashtbl.find types_table s).parser_arity with Not_found -> - try List.assoc s !types_external + try List.assoc s ~map:!types_external with Not_found -> prerr_string "Type "; prerr_string s; @@ -344,8 +347,8 @@ let enter_subtype typ arity subtyp constructors = in (* TODO: duplicate def in subtype are not checked *) typdef.subtypes <- - (subtyp , Sort.list real_constructors - ~order:(fun c1 c2 -> c1.var_name <= c2.var_name)) :: + (subtyp , List.sort real_constructors + ~cmp:(fun c1 c2 -> compare c1.var_name c2.var_name)) :: typdef.subtypes end @@ -385,13 +388,13 @@ let enter_widget name components = | External, _ -> () end; let commands = - try List.assoc Command sorted_components + try List.assoc Command ~map:sorted_components with Not_found -> [] and externals = - try List.assoc External sorted_components + try List.assoc External ~map:sorted_components with Not_found -> [] in - Hashtbl.add module_table ~key:name + Hashtbl'.add module_table ~key:name ~data:{module_type = Widget; commands = commands; externals = externals} (******************** Functions ********************) @@ -412,12 +415,11 @@ let enter_module name components = | External, _ -> () end; let commands = - try List.assoc Command sorted_components + try List.assoc Command ~map:sorted_components with Not_found -> [] and externals = - try List.assoc External sorted_components + try List.assoc External ~map:sorted_components with Not_found -> [] in - Hashtbl.add module_table ~key:name + Hashtbl'.add module_table ~key:name ~data:{module_type = Family; commands = commands; externals = externals} - |