Commit 4bfbb32a authored by Raphael Rieu-Helft's avatar Raphael Rieu-Helft

C extraction: use the syntax literal driver entries for number constants

parent 5e540a79
...@@ -23,7 +23,7 @@ end ...@@ -23,7 +23,7 @@ end
module mach.int.Int32 module mach.int.Int32
syntax type int32 "int32_t" syntax type int32 "int32_t"
syntax literal int32 "%d" syntax literal int32 "%c"
syntax val (+) "%1 + %2" prec 4 4 3 syntax val (+) "%1 + %2" prec 4 4 3
syntax val (-) "%1 - %2" prec 4 4 3 syntax val (-) "%1 - %2" prec 4 4 3
...@@ -49,7 +49,7 @@ end ...@@ -49,7 +49,7 @@ end
module mach.int.UInt32 module mach.int.UInt32
syntax literal uint32 "0x%8xU" syntax literal uint32 "%cU"
syntax val (+) "%1 + %2" prec 4 4 3 syntax val (+) "%1 + %2" prec 4 4 3
syntax val (-) "%1 - %2" prec 4 4 3 syntax val (-) "%1 - %2" prec 4 4 3
...@@ -181,7 +181,7 @@ struct __lsld32_result ...@@ -181,7 +181,7 @@ struct __lsld32_result
struct __lsld32_result lsld32(uint32_t x, uint32_t cnt); struct __lsld32_result lsld32(uint32_t x, uint32_t cnt);
" "
syntax literal uint32 "0x%8xU" syntax literal uint32 "%cU"
syntax val (+) "%1 + %2" prec 4 4 3 syntax val (+) "%1 + %2" prec 4 4 3
syntax val (-) "%1 - %2" prec 4 4 3 syntax val (-) "%1 - %2" prec 4 4 3
...@@ -223,7 +223,7 @@ end ...@@ -223,7 +223,7 @@ end
module mach.int.Int64 module mach.int.Int64
syntax type int64 "int64_t" syntax type int64 "int64_t"
syntax literal int64 "%dL" syntax literal int64 "INT64_C(%c)"
syntax val (+) "%1 + %2" prec 4 4 3 syntax val (+) "%1 + %2" prec 4 4 3
syntax val (-) "%1 - %2" prec 4 4 3 syntax val (-) "%1 - %2" prec 4 4 3
...@@ -250,7 +250,7 @@ end ...@@ -250,7 +250,7 @@ end
module mach.int.UInt64 module mach.int.UInt64
syntax literal uint64 "0x%16xUL" syntax literal uint64 "UINT64_C(%c)"
syntax val (+) "%1 + %2" prec 4 4 3 syntax val (+) "%1 + %2" prec 4 4 3
syntax val (-) "%1 - %2" prec 4 4 3 syntax val (-) "%1 - %2" prec 4 4 3
...@@ -505,7 +505,7 @@ static struct __lsld64_result lsld64(uint64_t x, uint64_t cnt) ...@@ -505,7 +505,7 @@ static struct __lsld64_result lsld64(uint64_t x, uint64_t cnt)
return result; return result;
} }
" "
syntax literal uint64 "0x%16xUL" syntax literal uint64 "UINT64_C(%c)"
syntax val uint64_max "0xffffffffffffffffUL" prec 0 syntax val uint64_max "0xffffffffffffffffUL" prec 0
......
...@@ -924,30 +924,31 @@ module MLToC = struct ...@@ -924,30 +924,31 @@ module MLToC = struct
let e = C.Evar id in let e = C.Evar id in
([], expr_or_return env e) ([], expr_or_return env e)
| Mltree.Econst ic -> | Mltree.Econst ic ->
let open Number in let open Number in
let print fmt ic =
let n = ic.il_int in let n = ic.il_int in
let n = if BigInt.lt n BigInt.zero
if BigInt.lt n BigInt.zero then BigInt.to_string n then Format.fprintf fmt "-%a" (print_in_base 10 None) (BigInt.abs n)
else else
match ic.il_kind with match ic.il_kind with
| ILitHex -> Format.asprintf "0x%a" (print_in_base 16 None) n | ILitHex -> Format.fprintf fmt "0x%a" (print_in_base 16 None) n
| ILitOct -> Format.asprintf "0%a" (print_in_base 8 None) n | ILitOct -> Format.fprintf fmt "0%a" (print_in_base 8 None) n
| _ -> BigInt.to_string n in | _ ->
let suf = (* default to base 10 *)
match e.e_ity with Format.fprintf fmt "%a" (print_in_base 10 None) n in
| I i -> let s = match e.e_ity with
begin match (ty_of_ity i).ty_node with | I i ->
| Tyapp ({ts_def = Range { ir_lower = l; ir_upper = h }},_) -> let ts = match (ty_of_ity i) with
let open BigInt in | { ty_node = Tyapp (ts, []) } -> ts
let unsigned = eq l zero in | _ -> assert false in
if (le min32 l) && (le h max32) then "" begin match query_syntax info.literal ts.ts_name with
else if unsigned && (le h maxu32) then "u" | Some st ->
else if (le min64 l) && (le h max64) then "l" Format.asprintf "%a" (syntax_range_literal ~cb:(Some print) st) ic
else if unsigned && (le h maxu64) then "ul" | _ ->
else raise (Unsupported "unknown number format") let s = ts.ts_name.id_string in
| _ -> raise (Unsupported "non-range integer constant") end raise (Unsupported ("unspecified number format for type "^s)) end
| _ -> assert false in | _ -> assert false in
let e = C.(Econst (Cint (n^suf))) in let e = C.(Econst (Cint s)) in
([], expr_or_return env e) ([], expr_or_return env e)
| Eapp (rs, el) | Eapp (rs, el)
when is_struct_constructor info rs when is_struct_constructor info rs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment