jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Switch to non-deprecated String functions

Browse source 
Use of String.*_ascii non-deprecated versions.

NB: Heptagon becomes available only for Ocaml versions >= 4.03.0.
This commit is contained in:
Gwenaël Delaval 2017-03-14 12:24:29 +01:00
parent d2dfed5019
commit e4f51fea68
21 changed files with 165 additions and 165 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
CHANGES
View file

@ -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)
-----------------------------

2
Makefile-distrib
View file

@ -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)

2
compiler/global/modules.ml
View file

@ -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

4
compiler/heptagon/ctrln/ctrlNbacAsEpt.ml
View file

@ -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); *)

22
compiler/heptagon/parsing/hept_lexer.mll
View file

@ -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'

2
compiler/heptagon/transformations/automata.ml
View file

@ -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

2
compiler/main/ctrl2ept.ml
View file

@ -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;

9
compiler/main/heptc.ml
View file

@ -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;

2
compiler/main/hepts.ml
View file

@ -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

2
compiler/main/mls2seq.ml
View file

@ -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;

168
compiler/minils/sigali/sigalimain.ml
View file

@ -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 =

2
compiler/minils/transformations/callgraph.ml
View file

@ -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

2
compiler/obc/c/c.ml
View file

@ -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;

2
compiler/obc/c/cgen.ml
View file

@ -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

2
compiler/obc/c/cmain.ml
View file

@ -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 =

13
compiler/obc/java/obc2java.ml
View file

@ -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

74
compiler/obc/java/obc2java14.ml
View file

@ -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

7
compiler/obc/java/old_java.ml
View file

@ -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 "@[<v>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@[<v 2>public class %s {@ " clid;
@ -526,7 +527,7 @@ let print_class_and_answer_to_file java_dir headers ts opened_mod cl =
(* fprintf ff "@[<v>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 "@.";

2
compiler/utilities/ctrln/ctrln_utils.ml
View file

@ -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

2
compiler/utilities/global/compiler_options.ml
View file

@ -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 *)

2
compiler/utilities/global/compiler_utils.ml
View file

@ -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