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

Fix for identifiers in C

Browse source 
Instead of calling cname_of_name before creating 
the C ast, keep original names and convert them
when pretty printing the code.
This commit is contained in:
Cédric Pasteur 2010-07-16 13:48:37 +02:00
parent cdc9b14a44
commit d42e56203b
2 changed files with 43 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -21,6 +21,21 @@ let rec print_list ff print sep l =
fprintf ff "%s@ " sep;
print_list ff print sep l
(** [cname_of_name name] translates the string [name] to a valid C identifier.
Copied verbatim from the old C backend. *)
let cname_of_name name =
let buf = Buffer.create (String.length name) in
let rec convert c =
match c with
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' ->
Buffer.add_char buf c
| '\'' -> Buffer.add_string buf "_prime"
| _ ->
Buffer.add_string buf "lex";
Buffer.add_string buf (string_of_int (Char.code c));
Buffer.add_string buf "_" in
String.iter convert name;
Buffer.contents buf
(******************************)
@ -141,13 +156,14 @@ let rec pp_list f sep fmt l = match l with
| [] -> fprintf fmt ""
| h :: t -> fprintf fmt "@ %a%s%a" f h sep (pp_list f sep) t
let pp_string fmt s = fprintf fmt "%s" s
let pp_string fmt s =
fprintf fmt "%s" (cname_of_name s)
let rec pp_cty fmt cty = match cty with
| Cty_int -> fprintf fmt "int"
| Cty_float -> fprintf fmt "float"
| Cty_char -> fprintf fmt "char"
| Cty_id s -> fprintf fmt "%s" s
| Cty_id s -> pp_string fmt s
| Cty_ptr cty' -> fprintf fmt "%a*" pp_cty cty'
| Cty_arr (n, cty') -> fprintf fmt "%a[%d]" pp_cty cty' n
| Cty_void -> fprintf fmt "void"
@ -171,10 +187,10 @@ let rec pp_param_cty fmt = function
let rec pp_vardecl fmt (s, cty) = match cty with
| Cty_arr (n, cty') ->
let ty, indices = pp_array_decl cty in
fprintf fmt "%a %s%s" pp_cty ty s indices
| _ -> fprintf fmt "%a %s" pp_cty cty s
fprintf fmt "%a %a%s" pp_cty ty pp_string s indices
| _ -> fprintf fmt "%a %a" pp_cty cty pp_string s
and pp_paramdecl fmt (s, cty) = match cty with
| Cty_arr (n, cty') -> fprintf fmt "%a* %s" pp_param_cty cty' s
| Cty_arr (n, cty') -> fprintf fmt "%a* %a" pp_param_cty cty' pp_string s
| _ -> pp_vardecl fmt (s, cty)
and pp_param_list fmt l = pp_list1 pp_paramdecl "," fmt l
and pp_var_list fmt l = pp_list pp_vardecl ";" fmt l
@ -200,8 +216,9 @@ and pp_cstm fmt stm = match stm with
fprintf fmt "@[<v>@[<v 2>if (%a) {%a@]@ @[<v 2>} else {%a@]@ }@]"
pp_cexpr c pp_cstm_list t pp_cstm_list e
| Cfor(x, lower, upper, e) ->
fprintf fmt "@[<v>@[<v 2>for (int %s = %d; %s < %d; ++%s) {%a@]@ }@]"
x lower x upper x pp_cstm_list e
fprintf fmt "@[<v>@[<v 2>for (int %a = %d; %a < %d; ++%a) {%a@]@ }@]"
pp_string x lower pp_string x
upper pp_string x pp_cstm_list e
| Cwhile (e, b) ->
fprintf fmt "@[<v>@[<v 2>while (%a) {%a@]@ }@]" pp_cexpr e pp_cstm_list b
| Csblock cb -> pp_cblock fmt cb
@ -210,23 +227,24 @@ and pp_cstm fmt stm = match stm with
and pp_cexpr fmt ce = match ce with
| Cuop (s, e) -> fprintf fmt "%s(%a)" s pp_cexpr e
| Cbop (s, l, r) -> fprintf fmt "(%a%s%a)" pp_cexpr l s pp_cexpr r
| Cfun_call (s, el) -> fprintf fmt "%s(@[%a@])" s (pp_list1 pp_cexpr ",") el
| Cfun_call (s, el) ->
fprintf fmt "%a(@[%a@])" pp_string s (pp_list1 pp_cexpr ",") el
| Cconst (Ccint i) -> fprintf fmt "%d" i
| Cconst (Ccfloat f) -> fprintf fmt "%f" f
| Cconst (Ctag "true") -> fprintf fmt "TRUE"
| Cconst (Ctag "false") -> fprintf fmt "FALSE"
| Cconst (Ctag t) -> fprintf fmt "%s" t
| Cconst (Ctag t) -> pp_string fmt t
| Cconst (Cstrlit t) -> fprintf fmt "\"%s\"" t
| Clhs lhs -> fprintf fmt "%a" pp_clhs lhs
| Caddrof lhs -> fprintf fmt "&%a" pp_clhs lhs
| Cstructlit (s, el) ->
fprintf fmt "(%s){@[%a@]}" s (pp_list1 pp_cexpr ",") el
fprintf fmt "(%a){@[%a@]}" pp_string s (pp_list1 pp_cexpr ",") el
| Carraylit el ->
fprintf fmt "((int *){@[%a@]})" (pp_list1 pp_cexpr ",") el (* WRONG *)
and pp_clhs fmt lhs = match lhs with
| Cvar s -> fprintf fmt "%s" s
| Cvar s -> pp_string fmt s
| Cderef lhs' -> fprintf fmt "*%a" pp_clhs lhs'
| Cfield (Cderef lhs, f) -> fprintf fmt "%a->%s" pp_clhs lhs f
| Cfield (Cderef lhs, f) -> fprintf fmt "%a->%a" pp_clhs lhs pp_string f
| Cfield (lhs, f) -> fprintf fmt "%a.%s" pp_clhs lhs f
| Carray (lhs, e) ->
fprintf fmt "%a[%a]"
@ -235,14 +253,14 @@ and pp_clhs fmt lhs = match lhs with
let pp_cdecl fmt cdecl = match cdecl with
| Cdecl_enum (s, sl) ->
fprintf fmt "@[<v>@[<v 2>typedef enum {@ %a@]@ } %s;@ @]@\n"
(pp_list1 pp_string ",") sl s
fprintf fmt "@[<v>@[<v 2>typedef enum {@ %a@]@ } %a;@ @]@\n"
(pp_list1 pp_string ",") sl pp_string s
| Cdecl_struct (s, fl) ->
let pp_field fmt (s, cty) =
fprintf fmt "@ %a;" pp_vardecl (s,cty) in
fprintf fmt "@[<v>@[<v 2>typedef struct %s {" s;
fprintf fmt "@[<v>@[<v 2>typedef struct %a {" pp_string s;
List.iter (pp_field fmt) fl;
fprintf fmt "@]@ } %s;@ @]@\n" s
fprintf fmt "@]@ } %a;@ @]@\n" pp_string s
| Cdecl_function (n, retty, args) ->
fprintf fmt "@[<v>%a %s(@[<hov>%a@]);@ @]@\n"
pp_cty retty n pp_param_list args
@ -253,7 +271,7 @@ let pp_cdef fmt cdef = match cdef with
"@[<v>@[<v 2>%a %s(@[<hov>%a@]) {%a@]@ }@ @]@\n"
pp_cty cfd.f_retty cfd.f_name pp_param_list cfd.f_args
pp_cblock cfd.f_body
| Cvardef (s, cty) -> fprintf fmt "%a %s;@\n" pp_cty cty s
| Cvardef (s, cty) -> fprintf fmt "%a %a;@\n" pp_cty cty pp_string s
let pp_cfile_desc fmt filen cfile =
(** [filen_wo_ext] is the file's name without the extension. *)
@ -297,22 +315,6 @@ let output dir cprog =
(** { Lexical conversions to C's syntax } *)
(** [cname_of_name name] translates the string [name] to a valid C identifier.
Copied verbatim from the old C backend. *)
let cname_of_name name =
let buf = Buffer.create (String.length name) in
let rec convert c =
match c with
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' ->
Buffer.add_char buf c
| '\'' -> Buffer.add_string buf "_prime"
| _ ->
Buffer.add_string buf "lex";
Buffer.add_string buf (string_of_int (Char.code c));
Buffer.add_string buf "_" in
String.iter convert name;
Buffer.contents buf
(** Converts an expression to a lhs. *)
let lhs_of_exp e =
match e with

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

@ -57,10 +57,6 @@ let rec struct_name ty =
let int_of_static_exp se =
Static.int_of_static_exp NamesEnv.empty se
let cname_of_name' name = match name with
| Name n -> Name (cname_of_name n)
| _ -> name
(* Functions to deal with opened modules set. *)
type world = { mutable opened_modules : S.t }
let world = { opened_modules = S.empty }
@ -91,17 +87,18 @@ let node_info classln =
id = modname_name }))
with Not_found ->
(* name might be of the form Module.name, remove the module name*)
let ind_name = (String.length modname) + 1 in
(*let ind_name = (String.length modname) + 1 in
let name = String.sub modname_name ind_name
((String.length modname_name)-ind_name) in
begin try
modname, find_value (Modname({qual = modname;
id = name }))
with Not_found ->
Error.message no_location (Error.Enode name)
end
with Not_found ->*)
Error.message no_location (Error.Enode modname)
(*end *)
end
| Name n ->
assert false;
Error.message no_location (Error.Enode n)
let output_names_list sig_info =
@ -544,7 +541,7 @@ let fun_def_of_step_fun name obj_env mem objs md =
let out_vars =
unique
(List.map (fun obj -> out_var_name_of_objn (shortname obj.o_class),
Cty_id ((cname_of_name (shortname obj.o_class)) ^ "_out"))
Cty_id ((shortname obj.o_class) ^ "_out"))
(List.filter (fun obj -> not (is_op obj.o_class)) objs)) in
(** The body *)
@ -575,7 +572,7 @@ let mem_decl_of_class_def cd =
let struct_field_of_obj_dec l od =
if is_statefull od.o_class then
let clsname = shortname od.o_class in
let ty = Cty_id ((cname_of_name clsname) ^ "_mem") in
let ty = Cty_id (clsname ^ "_mem") in
let ty = match od.o_size with
| Some se -> Cty_arr (int_of_static_exp se, ty)
| None -> ty in
@ -623,11 +620,8 @@ let cdefs_and_cdecls_of_class_def cd =
let step_m = find_step_method cd in
let memory_struct_decl = mem_decl_of_class_def cd in
let out_struct_decl = out_decl_of_class_def cd in
let obj_env =
List.map (fun od -> { od with o_class = cname_of_name' od.o_class })
cd.cd_objs in
let step_fun_def
= fun_def_of_step_fun cd.cd_name obj_env cd.cd_mems cd.cd_objs step_m in
= fun_def_of_step_fun cd.cd_name cd.cd_objs cd.cd_mems cd.cd_objs step_m in
(** C function for resetting our memory structure. *)
let reset_fun_def = reset_fun_def_of_class_def cd in
let res_fun_decl = cdecl_of_cfundef reset_fun_def in