Commit 09de883e authored by Raphaël Rieu-Helft's avatar Raphaël Rieu-Helft

Merge branch 'c_literals' into 'master'

Use syntax literal driver entries for C number constants

See merge request !107
parents b5ff7fcf a9d3d6c7
...@@ -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
......
...@@ -137,7 +137,7 @@ let opt_search_forward_literal_format s pos = ...@@ -137,7 +137,7 @@ let opt_search_forward_literal_format s pos =
end; end;
while !i < l && is_digit s.[!i] do incr i done; while !i < l && is_digit s.[!i] do incr i done;
begin match s.[!i] with begin match s.[!i] with
| 'b' | 'x' | 'o' | 'd' -> incr i; raise Exit | 'b' | 'x' | 'o' | 'd' | 'c' -> incr i; raise Exit
| _ -> () | _ -> ()
end; end;
end; end;
...@@ -283,36 +283,42 @@ let syntax_arguments_typed_prec = ...@@ -283,36 +283,42 @@ let syntax_arguments_typed_prec =
let syntax_arguments_typed s print_arg print_type t fmt l = let syntax_arguments_typed s print_arg print_type t fmt l =
syntax_arguments_typed_prec s (fun _ f a -> print_arg f a) print_type t [] fmt l syntax_arguments_typed_prec s (fun _ f a -> print_arg f a) print_type t [] fmt l
let syntax_range_literal s fmt c = let syntax_range_literal ?(cb=None) s fmt c =
let f s b e fmt = let f s b e fmt =
let v = c.Number.il_int in try
let base = match s.[e-1] with let v = c.Number.il_int in
| 'x' -> 16 let base = match s.[e-1] with
| 'd' -> 10 | 'x' -> 16
| 'o' -> 8 | 'd' -> 10
| 'b' -> 2 | 'o' -> 8
| _ -> assert false | 'b' -> 2
in | 'c' -> raise Exit
let digits = | _ -> assert false
if e > b + 1 then in
Some (int_of_string (String.sub s b (e-b-1))) let digits =
else if e > b + 1 then
None Some (int_of_string (String.sub s b (e-b-1)))
in else
if base = 10 then begin None
if BigInt.lt v BigInt.zero then fprintf fmt "-";
Number.print_in_base base digits fmt (BigInt.abs v)
end
else
let v =
if BigInt.lt v BigInt.zero then
match digits with
| Some d ->
BigInt.add (BigInt.pow_int_pos base d) v
| None -> failwith ("number of digits must be given for printing negative literals in base " ^ string_of_int base)
else v
in in
Number.print_in_base base digits fmt v if base = 10 then begin
if BigInt.lt v BigInt.zero then fprintf fmt "-";
Number.print_in_base base digits fmt (BigInt.abs v)
end
else
let v =
if BigInt.lt v BigInt.zero then
match digits with
| Some d ->
BigInt.add (BigInt.pow_int_pos base d) v
| None -> failwith ("number of digits must be given for printing negative literals in base " ^ string_of_int base)
else v
in
Number.print_in_base base digits fmt v
with Exit ->
match cb with
| Some cb -> cb fmt c
| None -> failwith ("custom format string with no callback passed")
in in
global_substitute_fmt opt_search_forward_literal_format f s fmt global_substitute_fmt opt_search_forward_literal_format f s fmt
......
...@@ -124,7 +124,7 @@ val syntax_arguments_typed : ...@@ -124,7 +124,7 @@ val syntax_arguments_typed :
string -> term Pp.pp -> ty Pp.pp -> term -> term list Pp.pp string -> term Pp.pp -> ty Pp.pp -> term -> term list Pp.pp
val syntax_range_literal : val syntax_range_literal :
string -> Number.int_constant Pp.pp ?cb:(Number.int_constant Pp.pp option) -> string -> Number.int_constant Pp.pp
val syntax_float_literal : val syntax_float_literal :
string -> Number.float_format -> Number.real_constant Pp.pp string -> Number.float_format -> Number.real_constant Pp.pp
......
...@@ -924,30 +924,33 @@ module MLToC = struct ...@@ -924,30 +924,33 @@ 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
else (* default to base 10 for negative literals *)
match ic.il_kind with Format.fprintf fmt "-%a" (print_in_base 10 None) (BigInt.abs n)
| ILitHex -> Format.asprintf "0x%a" (print_in_base 16 None) n else
| ILitOct -> Format.asprintf "0%a" (print_in_base 8 None) n match ic.il_kind with
| _ -> BigInt.to_string n in | ILitHex | ILitBin -> Format.fprintf fmt "0x%a" (print_in_base 16 None) n
let suf = | ILitOct -> Format.fprintf fmt "0%a" (print_in_base 8 None) n
match e.e_ity with | ILitDec | ILitUnk ->
| I i -> (* default to base 10 *)
begin match (ty_of_ity i).ty_node with Format.fprintf fmt "%a" (print_in_base 10 None) n in
| Tyapp ({ts_def = Range { ir_lower = l; ir_upper = h }},_) -> let s = match e.e_ity with
let open BigInt in | I i ->
let unsigned = eq l zero in let ts = match (ty_of_ity i) with
if (le min32 l) && (le h max32) then "" | { ty_node = Tyapp (ts, []) } -> ts
else if unsigned && (le h maxu32) then "u" | _ -> assert false in
else if (le min64 l) && (le h max64) then "l" begin match query_syntax info.literal ts.ts_name with
else if unsigned && (le h maxu64) then "ul" | Some st ->
else raise (Unsupported "unknown number format") Format.asprintf "%a" (syntax_range_literal ~cb:(Some print) st) ic
| _ -> raise (Unsupported "non-range integer constant") end | _ ->
| _ -> assert false in let s = ts.ts_name.id_string in
let e = C.(Econst (Cint (n^suf))) in raise (Unsupported ("unspecified number format for type "^s)) end
| _ -> assert false 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
......
...@@ -188,7 +188,7 @@ let print_in_base radix digits fmt i = ...@@ -188,7 +188,7 @@ let print_in_base radix digits fmt i =
let d,m = BigInt.euclidean_div_mod i radix in let d,m = BigInt.euclidean_div_mod i radix in
aux (digits - 1) d; aux (digits - 1) d;
Format.pp_print_char fmt (char_of_int (BigInt.to_int m)) in Format.pp_print_char fmt (char_of_int (BigInt.to_int m)) in
aux (Opt.get_def 0 digits) i aux (Opt.get_def 1 digits) i
let to_small_integer i = let to_small_integer i =
BigInt.to_int i.il_int BigInt.to_int i.il_int
......
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