@@ -90,23 +90,22 @@ let coqstring p s =
90
90
91
91
exception Not_an_identifier
92
92
93
+ let sanitize_char = function
94
+ | 'A' ..'Z' | 'a' ..'z' | '0' ..'9' | '_' as c -> c
95
+ | ' ' | '$' -> '_'
96
+ | _ -> raise Not_an_identifier
97
+
93
98
let sanitize s =
94
- let s' = Bytes. create (String. length s) in
95
- for i = 0 to String. length s - 1 do
96
- Bytes. set s' i
97
- (match String. get s i with
98
- | 'A' ..'Z' | 'a' ..'z' | '0' ..'9' | '_' as c -> c
99
- | ' ' | '$' -> '_'
100
- | _ -> raise Not_an_identifier )
101
- done ;
102
- Bytes. to_string s'
99
+ if s <> " "
100
+ then " _" ^ String. map sanitize_char s
101
+ else " empty_ident"
103
102
104
103
let temp_names : (ident, string) Hashtbl.t = Hashtbl. create 17
105
104
106
105
let ident p id =
107
106
try
108
107
let s = Hashtbl. find string_of_atom id in
109
- fprintf p " _ %s" (sanitize s)
108
+ fprintf p " %s" (sanitize s)
110
109
with Not_found | Not_an_identifier ->
111
110
try
112
111
let s = Hashtbl. find temp_names id in
@@ -125,10 +124,10 @@ let define_idents p =
125
124
(fun (id , name ) ->
126
125
try
127
126
if ! use_canonical_atoms && id = pos_of_string name then
128
- fprintf p " Definition _ %s : ident := $\" %s\" .@ "
127
+ fprintf p " Definition %s : ident := $\" %s\" .@ "
129
128
(sanitize name) name
130
129
else
131
- fprintf p " Definition _ %s : ident := %a.@ "
130
+ fprintf p " Definition %s : ident := %a.@ "
132
131
(sanitize name) positive id
133
132
with Not_an_identifier ->
134
133
() );
@@ -415,7 +414,7 @@ and lblstmts p = function
415
414
(print_option coqZ) lbl stmt s lblstmts ls
416
415
417
416
let print_function p (id , f ) =
418
- fprintf p " Definition f_ %s := {|@ " (sanitize (extern_atom id));
417
+ fprintf p " Definition f %s := {|@ " (sanitize (extern_atom id));
419
418
fprintf p " fn_return := %a;@ " typ f.fn_return;
420
419
fprintf p " fn_callconv := %a;@ " callconv f.fn_callconv;
421
420
fprintf p " fn_params := %a;@ " (print_list (print_pair ident typ)) f.fn_params;
@@ -436,7 +435,7 @@ let init_data p = function
436
435
| Init_addrof (id ,ofs ) -> fprintf p " Init_addrof %a %a" ident id coqptrofs ofs
437
436
438
437
let print_variable p (id , v ) =
439
- fprintf p " Definition v_ %s := {|@ " (sanitize (extern_atom id));
438
+ fprintf p " Definition v %s := {|@ " (sanitize (extern_atom id));
440
439
fprintf p " gvar_info := %a;@ " typ v.gvar_info;
441
440
fprintf p " gvar_init := %a;@ " (print_list init_data) v.gvar_init;
442
441
fprintf p " gvar_readonly := %B;@ " v.gvar_readonly;
@@ -451,12 +450,12 @@ let print_globdef p (id, gd) =
451
450
452
451
let print_ident_globdef p = function
453
452
| (id , Gfun(Ctypes. Internal f )) ->
454
- fprintf p " (%a, Gfun(Internal f_ %s))" ident id (sanitize (extern_atom id))
453
+ fprintf p " (%a, Gfun(Internal f %s))" ident id (sanitize (extern_atom id))
455
454
| (id , Gfun(Ctypes. External(ef , targs , tres , cc ))) ->
456
455
fprintf p " @[<hov 2>(%a,@ @[<hov 2>Gfun(External %a@ %a@ %a@ %a))@]@]"
457
456
ident id external_function ef typlist targs typ tres callconv cc
458
457
| (id , Gvar v ) ->
459
- fprintf p " (%a, Gvar v_ %s)" ident id (sanitize (extern_atom id))
458
+ fprintf p " (%a, Gvar v %s)" ident id (sanitize (extern_atom id))
460
459
461
460
(* Composite definitions *)
462
461
0 commit comments