From e4f51fea6822375bba0cf00e05ae0fb252889503 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gwena=C3=ABl=20Delaval?= Date: Tue, 14 Mar 2017 12:24:29 +0100 Subject: [PATCH] Switch to non-deprecated String functions Use of String.*_ascii non-deprecated versions. NB: Heptagon becomes available only for Ocaml versions >= 4.03.0. --- CHANGES | 7 + Makefile-distrib | 2 +- compiler/global/modules.ml | 2 +- compiler/heptagon/ctrln/ctrlNbacAsEpt.ml | 4 +- compiler/heptagon/parsing/hept_lexer.mll | 22 +-- compiler/heptagon/transformations/automata.ml | 2 +- compiler/main/ctrl2ept.ml | 2 +- compiler/main/heptc.ml | 9 +- compiler/main/hepts.ml | 2 +- compiler/main/mls2seq.ml | 2 +- compiler/minils/sigali/sigalimain.ml | 168 +++++++++--------- compiler/minils/transformations/callgraph.ml | 2 +- compiler/obc/c/c.ml | 2 +- compiler/obc/c/cgen.ml | 2 +- compiler/obc/c/cmain.ml | 2 +- compiler/obc/java/obc2java.ml | 13 +- compiler/obc/java/obc2java14.ml | 74 ++++---- compiler/obc/java/old_java.ml | 7 +- compiler/utilities/ctrln/ctrln_utils.ml | 2 +- compiler/utilities/global/compiler_options.ml | 2 +- compiler/utilities/global/compiler_utils.ml | 2 +- 21 files changed, 165 insertions(+), 165 deletions(-) diff --git a/CHANGES b/CHANGES index 8b4e074..0bd82b4 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,10 @@ +Heptagon 1.03.03 (14/03/2017) +----------------------------- + + - Correction in Ctrl-n backend: suppression of erroneous "c_" prefixes + - Correction in Ctrl2ept: no systematic conversion from int to float + - Correction in Ctrl-n backend: handling of implication and "xor" operators + Heptagon 1.03.02 (08/02/2017) ----------------------------- diff --git a/Makefile-distrib b/Makefile-distrib index 903e9de..91a9640 100644 --- a/Makefile-distrib +++ b/Makefile-distrib @@ -2,7 +2,7 @@ include config #version = $(shell date +"%d%m%y") -version = 1.03.02 +version = 1.03.03 osname=$(shell uname -s) hardware=$(shell uname -m) heptdir = heptagon-$(version) diff --git a/compiler/global/modules.ml b/compiler/global/modules.ml index 0d30a64..7c47143 100644 --- a/compiler/global/modules.ml +++ b/compiler/global/modules.ml @@ -107,7 +107,7 @@ let _load_module modul = | Names.LocalModule -> Misc.internal_error "modules" | Names.QualModule _ -> Misc.unsupported "modules" in - let name = String.uncapitalize modname in + let name = String.uncapitalize_ascii modname in try let filename = Compiler_utils.findfile (name ^ ".epci") in let ic = open_in_bin filename in diff --git a/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml b/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml index 9092ebb..9838ee5 100644 --- a/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml +++ b/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml @@ -285,7 +285,7 @@ let translate_expr gd e = let decl_typs modul_name typdefs = let qualify name = { qual = modul modul_name; name } in fold_typdefs begin fun tname tdef (types, typ_symbs) -> - let name = qualify (Symb.to_string tname |> String.uncapitalize) in + let name = qualify (Symb.to_string tname |> String.uncapitalize_ascii) in match tdef with | EnumDef labels, _ -> let constrs = List.map (fun (l, _) -> @@ -315,7 +315,7 @@ let decl_typs_from_module_itf modul_name = let t_desc, rem, (types, typ_symbs) = match tdef with | Tenum cl -> (* Compiler_utils.info "declaring enum type %s" (shortname t_name); *) - let name = Symb.of_string (String.capitalize (shortname t_name)) in + let name = Symb.of_string (String.capitalize_ascii (shortname t_name)) in (Type_enum cl, rem, (types, SMap.add name t_name typ_symbs)) | Talias (Tid tn) when tn.qual = t_name.qual -> (* declare deps 1st *) (* Compiler_utils.info "declaring alias type %s" (shortname t_name); *) diff --git a/compiler/heptagon/parsing/hept_lexer.mll b/compiler/heptagon/parsing/hept_lexer.mll index a7bbd61..867e858 100644 --- a/compiler/heptagon/parsing/hept_lexer.mll +++ b/compiler/heptagon/parsing/hept_lexer.mll @@ -112,30 +112,16 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [ (* To buffer string literals *) -let initial_string_buffer = String.create 256 -let string_buff = ref initial_string_buffer -let string_index = ref 0 +let string_buffer = Buffer.create 256 let reset_string_buffer () = - string_buff := initial_string_buffer; - string_index := 0; - () - + Buffer.reset string_buffer let store_string_char c = - if !string_index >= String.length (!string_buff) then begin - let new_buff = String.create (String.length (!string_buff) * 2) in - String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff)); - string_buff := new_buff - end; - String.set (!string_buff) (!string_index) c; - incr string_index - + Buffer.add_char string_buffer c let get_stored_string () = - let s = String.sub (!string_buff) 0 (!string_index) in - string_buff := initial_string_buffer; - s + Buffer.contents string_buffer let char_for_backslash = function 'n' -> '\010' diff --git a/compiler/heptagon/transformations/automata.ml b/compiler/heptagon/transformations/automata.ml index 696cf44..6527e79 100644 --- a/compiler/heptagon/transformations/automata.ml +++ b/compiler/heptagon/transformations/automata.ml @@ -72,7 +72,7 @@ let state_type_dec_list = ref [] (* create and add to the env the constructors corresponding to a name state *) let intro_state_constr type_name state state_env = - let n = String.capitalize (Names.shortname type_name) ^ "_" ^ state in + let n = String.capitalize_ascii (Names.shortname type_name) ^ "_" ^ state in let c = Modules.fresh_constr "automata" n in Modules.add_constrs c type_name; NamesEnv.add state c state_env diff --git a/compiler/main/ctrl2ept.ml b/compiler/main/ctrl2ept.ml index dcbf17c..4b35dbc 100644 --- a/compiler/main/ctrl2ept.ml +++ b/compiler/main/ctrl2ept.ml @@ -161,7 +161,7 @@ let parse_nodename nn = try Names.qualname_of_string nn with let output_prog prog modul = Modules.select modul; - let filename = String.uncapitalize (Names.modul_to_string modul) ^ ".ept" in + let filename = String.uncapitalize_ascii (Names.modul_to_string modul) ^ ".ept" in let oc = open_out filename in info "Outputting into `%s'…" filename; Hept_printer.print oc prog; diff --git a/compiler/main/heptc.ml b/compiler/main/heptc.ml index 1651fa2..1d52802 100644 --- a/compiler/main/heptc.ml +++ b/compiler/main/heptc.ml @@ -35,7 +35,7 @@ open Compiler_options let compile_interface modname source_f = (* output file names *) - let output = String.uncapitalize modname in + let output = String.uncapitalize_ascii modname in let epci_f = output ^ ".epci" in (* input/output channels *) @@ -64,7 +64,7 @@ let compile_interface modname source_f = let compile_program modname source_f = (* output file names *) - let output = String.uncapitalize modname in + let output = String.uncapitalize_ascii modname in let epci_f = output ^ ".epci" in let mls_f = output ^ ".mls" in @@ -100,7 +100,10 @@ let compile_program modname source_f = let compile source_f = - let modname = source_f |> Filename.basename |> Filename.chop_extension |> String.capitalize in + let modname = source_f + |> Filename.basename + |> Filename.chop_extension + |> String.capitalize_ascii in let modul = Names.modul_of_string modname in Initial.initialize modul; source_f |> Filename.dirname |> add_include; diff --git a/compiler/main/hepts.ml b/compiler/main/hepts.ml index 38a4404..8cf6607 100644 --- a/compiler/main/hepts.ml +++ b/compiler/main/hepts.ml @@ -342,7 +342,7 @@ let main () = if Filename.check_suffix epci_name ".epci" then begin let filename = Filename.chop_suffix epci_name ".epci" in - mod_name := String.capitalize(Filename.basename filename) + mod_name := String.capitalize_ascii(Filename.basename filename) end else raise (Arg.Bad("Invalid compiled interface: " ^ epci_name)) in diff --git a/compiler/main/mls2seq.ml b/compiler/main/mls2seq.ml index 3853160..df02fef 100644 --- a/compiler/main/mls2seq.ml +++ b/compiler/main/mls2seq.ml @@ -58,7 +58,7 @@ let mk_target ?(interface=IMinils ignore) ?(load_conf = no_conf) name pt = (** Writes a .epo file for program [p]. *) let write_object_file p = - let filename = (String.uncapitalize (Names.modul_to_string p.Minils.p_modname)) ^".epo" in + let filename = (String.uncapitalize_ascii (Names.modul_to_string p.Minils.p_modname)) ^".epo" in let epoc = open_out_bin filename in output_value epoc p; close_out epoc; diff --git a/compiler/minils/sigali/sigalimain.ml b/compiler/minils/sigali/sigalimain.ml index 4e707b8..fd2da98 100644 --- a/compiler/minils/sigali/sigalimain.ml +++ b/compiler/minils/sigali/sigalimain.ml @@ -103,11 +103,11 @@ let rec translate_ext prefix ({ Minils.w_desc = desc; Minils.w_ty = ty }) = (* get variable iff it is Boolean or local *) begin match (actual_ty ty) with | Tbool -> - Sigali.Svar(prefix ^ (name n)) + Sigali.Svar(prefix ^ (name n)) | Tint when (IdentSet.mem n !current_locals) -> - Sigali.Svar(prefix ^ (name n)) + Sigali.Svar(prefix ^ (name n)) | _ -> - raise Untranslatable + raise Untranslatable end (* TODO remove if this works without *) (* | Minils.Wwhen(e, c, var) when ((actual_ty e.Minils.w_ty) = Tbool) -> *) @@ -154,7 +154,7 @@ let rec translate prefix ({ Minils.e_desc = desc } as e) = | "<" -> a_inf,-1 | ">=" -> a_sup,0 | ">" -> a_sup,1 - | _ -> a_iminv,0 (* p(x)=k <> p = inverse image of k *) + | _ -> a_iminv,0 (* p(x)=k <> p = inverse image of k *) end in let e1 = translate_ext prefix e1 in let sig_e = @@ -168,8 +168,8 @@ let rec translate prefix ({ Minils.e_desc = desc } as e) = (* a_inf, a_sup and a_iminv : +1 to translate ideals to boolean polynomials *) Splus(sig_e,Sconst(Ctrue)) - | "<>", [e1;e2] -> - (* e1 <> e2 --> not(a_iminv((e1+(e2*(-1))),0)) *) + | "<>", [e1;e2] -> + (* e1 <> e2 --> not(a_iminv((e1+(e2*(-1))),0)) *) let e1 = translate_ext prefix e1 in let sig_e = begin match e2.Minils.w_desc with @@ -280,7 +280,7 @@ let translate_eq f | _ -> untranslatable_warn e; (* Mark n as input: unusable as local variable *) - warn ~cond:(!Compiler_options.warn_abstractions) + warn ~cond:(!Compiler_options.warn_abstractions) "Adding non-bool variable %s in current_inputs@\n" (name n); current_inputs := IdentSet.add n !current_inputs; acc_states,acc_init,acc_inputs,acc_eqs @@ -320,11 +320,11 @@ let translate_eq f with Untranslatable -> untranslatable_warn e; current_inputs := IdentSet.add n !current_inputs; - let acc_inputs = - match actual_ty e.Minils.e_ty with - | Tbool -> acc_inputs @ [(n,(prefixed (name n)))] - | _ -> acc_inputs - in + let acc_inputs = + match actual_ty e.Minils.e_ty with + | Tbool -> acc_inputs @ [(n,(prefixed (name n)))] + | _ -> acc_inputs + in acc_states,acc_init,acc_inputs,acc_eqs end | _ -> assert false @@ -360,15 +360,15 @@ let translate_contract f contract = (* separate reachability and attractivity and build one security objective [e_g] *) let e_g,sig_objs = - List.fold_left - (fun (e_g,sig_objs) o -> - let e_obj = translate_ext prefix o.Minils.o_exp in - match o.Minils.o_kind with - | Minils.Obj_enforce -> (e_g &~ e_obj), sig_objs - | Minils.Obj_reachable -> e_g, (Reachability e_obj) :: sig_objs - | Minils.Obj_attractive -> e_g, (Attractivity e_obj) :: sig_objs) - (e_g_loc,[]) - objs in + List.fold_left + (fun (e_g,sig_objs) o -> + let e_obj = translate_ext prefix o.Minils.o_exp in + match o.Minils.o_kind with + | Minils.Obj_enforce -> (e_g &~ e_obj), sig_objs + | Minils.Obj_reachable -> e_g, (Reachability e_obj) :: sig_objs + | Minils.Obj_attractive -> e_g, (Attractivity e_obj) :: sig_objs) + (e_g_loc,[]) + objs in let sig_objs = List.rev sig_objs in let body = @@ -427,19 +427,19 @@ let translate_node ([], sig_states, g_c) else begin - (* Sink state when the guarantee part of the contract becomes false *) - (* f_error_state state variable initialized to true; become false - the instant after the guarantee part is false *) - let error_state_name = f ^ "_error_state" in - let sig_states_full = sig_states @ [error_state_name] in - let body_sink = - [(extend + (* Sink state when the guarantee part of the contract becomes false *) + (* f_error_state state variable initialized to true; become false + the instant after the guarantee part is false *) + let error_state_name = f ^ "_error_state" in + let sig_states_full = sig_states @ [error_state_name] in + let body_sink = + [(extend initialisations (Slist[Sequal(Sigali.Svar(error_state_name),Sconst(Ctrue))])); - (extend + (extend evolutions (Slist[g_c]))] in - (body_sink, sig_states_full, Sigali.Svar(error_state_name)) + (body_sink, sig_states_full, Sigali.Svar(error_state_name)) end in let objs = Security(obj_exp) :: objs in let p = { proc_dep = []; @@ -465,62 +465,62 @@ let translate_node let ctrlr_call = begin match controllables with - [] -> [] (* no controllable => no controller call *) + [] -> [] (* no controllable => no controller call *) | _ :: _ -> - let ctrlr_pat = Minils.Etuplepat(List.map (fun { Minils.v_ident = v } -> - Minils.Evarpat(v)) - mls_ctrl) in - let ctrlr_name = f ^ "_controller" in - let ctrlr_fun_name = { qual = Module (String.capitalize ctrlr_name); - name = ctrlr_name } in - let ctrlr_exp = - Minils.mk_exp - Cbase - (Tprod (List.map (fun _ -> Initial.tbool) mls_ctrl)) - ~linearity:Linearity.Ltop - (Minils.Eapp(Minils.mk_app (Minils.Efun ctrlr_fun_name), - (List.map - (fun v -> - Minils.mk_extvalue - ~ty:Initial.tbool - ~linearity:Linearity.Ltop - ~clock:Cbase - (Minils.Wvar v)) - (mls_inputs@mls_states)) - @ (List.map - (fun _ -> - Minils.mk_extvalue - ~ty:Initial.tbool - ~linearity:Linearity.Ltop - ~clock:Cbase - (Minils.Wconst(Initial.mk_static_bool true))) - mls_ctrl), - None)) - in - let ctrlr_call = - Minils.mk_equation ~base_ck:Cbase false ctrlr_pat ctrlr_exp in + let ctrlr_pat = Minils.Etuplepat(List.map (fun { Minils.v_ident = v } -> + Minils.Evarpat(v)) + mls_ctrl) in + let ctrlr_name = f ^ "_controller" in + let ctrlr_fun_name = { qual = Module (String.capitalize_ascii ctrlr_name); + name = ctrlr_name } in + let ctrlr_exp = + Minils.mk_exp + Cbase + (Tprod (List.map (fun _ -> Initial.tbool) mls_ctrl)) + ~linearity:Linearity.Ltop + (Minils.Eapp(Minils.mk_app (Minils.Efun ctrlr_fun_name), + (List.map + (fun v -> + Minils.mk_extvalue + ~ty:Initial.tbool + ~linearity:Linearity.Ltop + ~clock:Cbase + (Minils.Wvar v)) + (mls_inputs@mls_states)) + @ (List.map + (fun _ -> + Minils.mk_extvalue + ~ty:Initial.tbool + ~linearity:Linearity.Ltop + ~clock:Cbase + (Minils.Wconst(Initial.mk_static_bool true))) + mls_ctrl), + None)) + in + let ctrlr_call = + Minils.mk_equation ~base_ck:Cbase false ctrlr_pat ctrlr_exp in - let ctrlr_inputs = - (List.map - (fun v -> - Signature.mk_arg (Some v) Initial.tbool Linearity.Ltop Signature.Cbase) - (sig_inputs@sig_states)) - @ (List.map - (fun v -> - Signature.mk_arg - (Some ("p_" ^ v)) Initial.tbool Linearity.Ltop Signature.Cbase) - sig_ctrl) in - let ctrlr_outputs = - List.map - (fun v -> - Signature.mk_arg (Some v) Initial.tbool Linearity.Ltop Signature.Cbase) - sig_ctrl in - let ctrlr_signature = - Signature.mk_node Location.no_location ~extern:false - ctrlr_inputs ctrlr_outputs false false [] in - (* Add controller into modules *) - Modules.add_value ctrlr_fun_name ctrlr_signature; - [ctrlr_call] + let ctrlr_inputs = + (List.map + (fun v -> + Signature.mk_arg (Some v) Initial.tbool Linearity.Ltop Signature.Cbase) + (sig_inputs@sig_states)) + @ (List.map + (fun v -> + Signature.mk_arg + (Some ("p_" ^ v)) Initial.tbool Linearity.Ltop Signature.Cbase) + sig_ctrl) in + let ctrlr_outputs = + List.map + (fun v -> + Signature.mk_arg (Some v) Initial.tbool Linearity.Ltop Signature.Cbase) + sig_ctrl in + let ctrlr_signature = + Signature.mk_node Location.no_location ~extern:false + ctrlr_inputs ctrlr_outputs false false [] in + (* Add controller into modules *) + Modules.add_value ctrlr_fun_name ctrlr_signature; + [ctrlr_call] end in let node = diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index 96153a2..64a23c0 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -260,7 +260,7 @@ let load_object_file modul = | Names.LocalModule -> Misc.internal_error "modules" | Names.QualModule _ -> Misc.unsupported "modules" in - let name = String.uncapitalize modname in + let name = String.uncapitalize_ascii modname in try let filename = Compiler_utils.findfile (name ^ ".epo") in let ic = open_in_bin filename in diff --git a/compiler/obc/c/c.ml b/compiler/obc/c/c.ml index ab53879..b679410 100644 --- a/compiler/obc/c/c.ml +++ b/compiler/obc/c/c.ml @@ -337,7 +337,7 @@ let pp_cfile_desc fmt filen cfile = let filen_wo_ext = String.sub filen 0 (String.length filen - 2) in match cfile with | Cheader (deps, cdecls) -> - let headern_macro = String.uppercase filen_wo_ext in + let headern_macro = String.uppercase_ascii filen_wo_ext in Compiler_utils.print_header_info fmt "/*" "*/"; fprintf fmt "#ifndef %s_H@\n" headern_macro; fprintf fmt "#define %s_H@\n@\n" headern_macro; diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 4cff332..4d8932f 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -848,7 +848,7 @@ let cdefs_and_cdecls_of_program_decl id = match id with let header_of_module m = match m with | Module "Iostream" -> "stdio" - | _ -> String.uncapitalize (modul_to_string m) + | _ -> String.uncapitalize_ascii (modul_to_string m) let global_file_header name prog = let dependencies = ModulSet.elements (Obc_utils.Deps.deps_program prog) in diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index 5989187..c78f39b 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -396,7 +396,7 @@ let mk_main name p = let translate name prog = let modname = (Filename.basename name) in - global_name := String.capitalize modname; + global_name := String.capitalize_ascii modname; (global_file_header modname prog) @ (mk_main name prog) let program p = diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index 0c4f7eb..f3e08a4 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -95,7 +95,8 @@ let translate_modul m = m (*match m with (** a [Module.const] becomes a [module.CONSTANTES.CONST] *) let translate_const_name { qual = m; name = n } = - { qual = QualModule { qual = translate_modul m; name = "CONSTANTES"}; name = String.uppercase n } + { qual = QualModule { qual = translate_modul m; name = "CONSTANTES"}; + name = String.uppercase_ascii n } (** a [Module.fun] becomes a [module.FUNS.fun] *) let translate_fun_name { qual = m; name = n } = @@ -104,11 +105,11 @@ let translate_fun_name { qual = m; name = n } = (** a [Module.name] becomes a [module.Name] used for type_names, class_names, fun_names *) let qualname_to_class_name q = - { qual = translate_modul q.qual; name = String.capitalize q.name } + { qual = translate_modul q.qual; name = String.capitalize_ascii q.name } (** a [Module.name] becomes a [module.Name] even on current_mod *) let qualname_to_package_classe q = - { qual = translate_modul q.qual; name = String.capitalize q.name } + { qual = translate_modul q.qual; name = String.capitalize_ascii q.name } (** Create a fresh class qual from a name *) let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_classe @@ -117,7 +118,7 @@ let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_cla becomes a [module.Enum.CONSTR] of the [module.Enum] class *) let translate_constructor_name_2 q q_ty = let classe = qualname_to_class_name q_ty in - { qual = QualModule classe; name = String.uppercase q.name } + { qual = QualModule classe; name = String.uppercase_ascii q.name } let translate_constructor_name q = let x = Modules.find_constrs q in @@ -126,7 +127,7 @@ let translate_constructor_name q = | Types.Tid q_ty -> translate_constructor_name_2 q q_ty | _ -> assert false -let translate_field_name f = f |> Names.shortname |> String.lowercase +let translate_field_name f = f |> Names.shortname |> String.lowercase_ascii (** a [name] becomes a [package.Name] *) let name_to_classe_name n = n |> Modules.current_qual |> qualname_to_package_classe @@ -402,7 +403,7 @@ and block param_env ?(locals=[]) ?(end_acts=[]) ob = @return [vds, param_env] *) let sig_params_to_vds p_l = let param_to_arg param_env p = - let p_ident = Idents.gen_var "obc2java" (String.uppercase p.Signature.p_name) in + let p_ident = Idents.gen_var "obc2java" (String.uppercase_ascii p.Signature.p_name) in let p_vd = Java.mk_var_dec p_ident false (ty param_env p.Signature.p_type) in let param_env = NamesEnv.add p.Signature.p_name p_ident param_env in p_vd, param_env diff --git a/compiler/obc/java/obc2java14.ml b/compiler/obc/java/obc2java14.ml index 00bfb32..a56dace 100644 --- a/compiler/obc/java/obc2java14.ml +++ b/compiler/obc/java/obc2java14.ml @@ -96,7 +96,8 @@ let translate_modul m = m (*match m with (** a [Module.const] becomes a [module.CONSTANTES.CONST] *) let translate_const_name { qual = m; name = n } = - { qual = QualModule { qual = translate_modul m; name = "CONSTANTES"}; name = String.uppercase n } + { qual = QualModule { qual = translate_modul m; name = "CONSTANTES"}; + name = String.uppercase_ascii n } (** a [Module.fun] becomes a [module.FUNS.fun] *) let translate_fun_name { qual = m; name = n } = @@ -105,11 +106,11 @@ let translate_fun_name { qual = m; name = n } = (** a [Module.name] becomes a [module.Name] used for type_names, class_names, fun_names *) let qualname_to_class_name q = - { qual = translate_modul q.qual; name = String.capitalize q.name } + { qual = translate_modul q.qual; name = String.capitalize_ascii q.name } (** a [Module.name] becomes a [module.Name] even on current_mod *) let qualname_to_package_classe q = - { qual = translate_modul q.qual; name = String.capitalize q.name } + { qual = translate_modul q.qual; name = String.capitalize_ascii q.name } (** Create a fresh class qual from a name *) let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_classe @@ -118,7 +119,7 @@ let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_cla becomes a [module.Enum.CONSTR] of the [module.Enum] class *) let translate_constructor_name_2 q q_ty = let classe = qualname_to_class_name q_ty in - { qual = QualModule classe; name = String.uppercase q.name } + { qual = QualModule classe; name = String.uppercase_ascii q.name } let translate_constructor_name q = match Modules.unalias_type (Types.Tid (Modules.find_constrs q)) with @@ -126,7 +127,7 @@ let translate_constructor_name q = | Types.Tid q_ty -> translate_constructor_name_2 q q_ty | _ -> assert false -let translate_field_name f = f |> Names.shortname |> String.lowercase +let translate_field_name f = f |> Names.shortname |> String.lowercase_ascii (** a [name] becomes a [package.Name] *) let name_to_classe_name n = n |> Modules.current_qual |> qualname_to_package_classe @@ -194,9 +195,9 @@ let rec static_exp param_env se = match se.Types.se_desc with | _ -> Misc.internal_error "Obc2java14" in let f_e_l = - List.sort - (fun (f1,_) (f2,_) -> compare f1.name f2.name) - f_e_l in + List.sort + (fun (f1,_) (f2,_) -> compare f1.name f2.name) + f_e_l in let e_l = List.map (fun (_f,e) -> e) f_e_l in Enew (Tclass ty_name, List.map (static_exp param_env) e_l) | Types.Sop (f, se_l) -> Efun (f, List.map (static_exp param_env) se_l) @@ -271,9 +272,9 @@ and exp param_env e = match e.e_desc with | Obc.Estruct (ty_name,f_e_l) -> let ty_name = qualname_to_package_classe ty_name in let f_e_l = - List.sort - (fun (f1,_) (f2,_) -> compare f1.name f2.name) - f_e_l in + List.sort + (fun (f1,_) (f2,_) -> compare f1.name f2.name) + f_e_l in let e_l = List.map (fun (_f,e) -> e) f_e_l in Enew (Tclass ty_name, exp_list param_env e_l) | Obc.Earray e_l -> Enew_array (ty param_env e.e_ty, exp_list param_env e_l) @@ -372,13 +373,13 @@ let rec act_list param_env act_l acts = (Aifelse (exp param_env e, block param_env _then, block param_env _else)) :: acts) | Obc.Acase (e, c_b_l) -> let _c_b (c,b) = - let type_name = - match e.e_ty with - Types.Tid n -> qualname_to_package_classe n - | _ -> failwith("act_list: translating case") in - let c = translate_constructor_name_2 c type_name in - Sexp(Sconstructor c), - block param_env b in + let type_name = + match e.e_ty with + Types.Tid n -> qualname_to_package_classe n + | _ -> failwith("act_list: translating case") in + let c = translate_constructor_name_2 c type_name in + Sexp(Sconstructor c), + block param_env b in let acase = Aswitch (exp param_env e, List.map _c_b c_b_l) in acase::acts | Obc.Afor (v, se, se', b) -> @@ -405,7 +406,7 @@ and block param_env ?(locals=[]) ?(end_acts=[]) ob = @return [vds, param_env] *) let sig_params_to_vds p_l = let param_to_arg param_env p = - let p_ident = Idents.gen_var "obc2java" (String.uppercase p.Signature.p_name) in + let p_ident = Idents.gen_var "obc2java" (String.uppercase_ascii p.Signature.p_name) in let p_vd = Java.mk_var_dec p_ident false (ty param_env p.Signature.p_type) in let param_env = NamesEnv.add p.Signature.p_name p_ident param_env in p_vd, param_env @@ -471,7 +472,8 @@ let class_def_list classes cd_l = let size_l = List.rev (List.map (static_exp param_env) size_l) in let t = Idents.Env.find od.o_ident obj_env in let assgn_elem i_l = - [ Java.Aassgn (Parray_elem (Pthis od.o_ident, List.map mk_var i_l), Enew (t, params)) ] + [ Java.Aassgn (Parray_elem (Pthis od.o_ident, List.map mk_var i_l), + Enew (t, params)) ] in (Java.Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size_l), []))) :: (fresh_nfor size_l assgn_elem) @@ -565,23 +567,23 @@ let type_dec_list classes td_l = see [Idents.enter_node classe_name] *) Java.mk_field jty field in - let f_l = - List.sort - (fun f1 f2 -> - compare (f1.Signature.f_name.name) (f2.Signature.f_name.name)) - f_l in - let fields = List.map mk_field_jfield f_l in - let cons_params = List.map + let f_l = + List.sort + (fun f1 f2 -> + compare (f1.Signature.f_name.name) (f2.Signature.f_name.name)) + f_l in + let fields = List.map mk_field_jfield f_l in + let cons_params = List.map (fun f -> Java.mk_var_dec f.f_ident false f.Java.f_type) fields in - let cons_body = - List.map - (fun f -> Java.Aassgn ((Pthis f.f_ident),(Evar f.f_ident))) - fields in - let cons = - mk_methode - ~args:cons_params - (Java.mk_block cons_body) - classe_name.name in + let cons_body = + List.map + (fun f -> Java.Aassgn ((Pthis f.f_ident),(Evar f.f_ident))) + fields in + let cons = + mk_methode + ~args:cons_params + (Java.mk_block cons_body) + classe_name.name in (mk_classe ~fields:fields ~constrs:[cons] classe_name) :: classes in List.fold_left _td classes td_l diff --git a/compiler/obc/java/old_java.ml b/compiler/obc/java/old_java.ml index 80e50a5..ec74463 100644 --- a/compiler/obc/java/old_java.ml +++ b/compiler/obc/java/old_java.ml @@ -147,7 +147,8 @@ let rec print_type_to_file java_dir headers { t_name = tn; t_desc = td} = List.iter (fprintf ff "%s") headers; (* fprintf ff "@[package %s;@\n@\n" headers; *) print_struct_type ff tn - (List.map (fun {f_name = n;f_type = t} -> (shortname n,t)) fields); (* TODO java deal with modules *) + (List.map (fun {f_name = n;f_type = t} -> (shortname n,t)) fields); + (* TODO java deal with modules *) fprintf ff "@."; close_out out_ch | Type_alias t -> assert false (* TODO java *) @@ -494,7 +495,7 @@ let print_class ff headers ts single opened_mod cl = (* import opened modules *) List.iter (fun m -> - fprintf ff "import %s.*;@\n" (String.uncapitalize m)) + fprintf ff "import %s.*;@\n" (String.uncapitalize_ascii m)) opened_mod; fprintf ff "@\n@[public class %s {@ " clid; @@ -526,7 +527,7 @@ let print_class_and_answer_to_file java_dir headers ts opened_mod cl = (* fprintf ff "@[package %s;@\n@\n" headers; *) List.iter (fun m -> - fprintf ff "import %s.*;@\n" (String.uncapitalize m)) + fprintf ff "import %s.*;@\n" (String.uncapitalize_ascii m)) opened_mod; print_ans_struct ff (clid ^ "Answer") cl.step.out; fprintf ff "@."; diff --git a/compiler/utilities/ctrln/ctrln_utils.ml b/compiler/utilities/ctrln/ctrln_utils.ml index ec3af7b..10c71f2 100644 --- a/compiler/utilities/ctrln/ctrln_utils.ml +++ b/compiler/utilities/ctrln/ctrln_utils.ml @@ -67,7 +67,7 @@ let controller_node ?num { qual; name } = match num with let save_controller_modul_for modul = let om = Modules.current () in let cm = controller_modul modul in - let epci = String.uncapitalize (Names.modul_to_string cm) ^ ".epci" in + let epci = String.uncapitalize_ascii (Names.modul_to_string cm) ^ ".epci" in Modules.select cm; (* XXX check for empty modules? *) let oc = open_out_bin epci in diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index f733df1..fb26450 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/compiler/utilities/global/compiler_options.ml @@ -32,7 +32,7 @@ open Names (* version of the compiler *) -let version = "1.03.02" +let version = "1.03.03" let date = "DATE" (* standard module *) diff --git a/compiler/utilities/global/compiler_utils.ml b/compiler/utilities/global/compiler_utils.ml index 489a6e0..7d3329e 100644 --- a/compiler/utilities/global/compiler_utils.ml +++ b/compiler/utilities/global/compiler_utils.ml @@ -97,7 +97,7 @@ let silent_pass d enabled f p = else p let filename_of_name n = - String.uncapitalize n + String.uncapitalize_ascii n let build_path suf = match !target_path with