Merge branch 'c_literals' into 'master'

Use syntax literal driver entries for C number constants

See merge request !107

drivers/c.drv

@@ -23,7 +23,7 @@ end
 module mach.int.Int32
 
   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
@@ -49,7 +49,7 @@ end
 
 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
@@ -181,7 +181,7 @@ struct __lsld32_result
 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
@@ -223,7 +223,7 @@ end
 
 module mach.int.Int64
   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
@@ -250,7 +250,7 @@ end
 
 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
@@ -505,7 +505,7 @@ static struct __lsld64_result lsld64(uint64_t x, uint64_t cnt)
   return result;
 }
 "
-  syntax literal uint64 "0x%16xUL"
+  syntax literal uint64 "UINT64_C(%c)"
 
   syntax val uint64_max "0xffffffffffffffffUL" prec 0
 

src/core/printer.ml

@@ -137,7 +137,7 @@ let opt_search_forward_literal_format s pos =
         end;
         while !i < l && is_digit s.[!i] do incr i done;
         begin match s.[!i] with
-        | 'b' | 'x' | 'o' | 'd' -> incr i; raise Exit
+        | 'b' | 'x' | 'o' | 'd' | 'c' -> incr i; raise Exit
         | _ -> ()
         end;
       end;
@@ -283,14 +283,16 @@ let syntax_arguments_typed_prec =
 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
 
-let syntax_range_literal s fmt c =
+let syntax_range_literal ?(cb=None) s fmt c =
   let f s b e fmt =
+    try
       let v = c.Number.il_int in
       let base = match s.[e-1] with
         | 'x' -> 16
         | 'd' -> 10
         | 'o' -> 8
         | 'b' -> 2
+        | 'c' -> raise Exit
         | _ -> assert false
       in
       let digits =
@@ -313,6 +315,10 @@ let syntax_range_literal s fmt c =
           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
   global_substitute_fmt opt_search_forward_literal_format f s fmt
 

src/core/printer.mli

@@ -124,7 +124,7 @@ val syntax_arguments_typed :
   string -> term Pp.pp -> ty Pp.pp -> term -> term list Pp.pp
 
 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 :
   string -> Number.float_format -> Number.real_constant Pp.pp

src/mlw/cprinter.ml

@@ -925,29 +925,32 @@ module MLToC = struct
        ([], expr_or_return env e)
     | Mltree.Econst ic ->
        let open Number in
+       let print fmt ic =
         let n = ic.il_int in
-        let n =
-          if BigInt.lt n BigInt.zero then BigInt.to_string n
+        if BigInt.lt n BigInt.zero
+        then
+          (* default to base 10 for negative literals *)
+          Format.fprintf fmt "-%a" (print_in_base 10 None) (BigInt.abs n)
         else
           match ic.il_kind with
-            | ILitHex -> Format.asprintf "0x%a" (print_in_base 16 None) n
-            | ILitOct -> Format.asprintf "0%a" (print_in_base 8 None) n
-            | _ -> BigInt.to_string n in
-        let suf =
-          match e.e_ity with
+          | ILitHex | ILitBin -> Format.fprintf fmt "0x%a" (print_in_base 16 None) n
+          | ILitOct -> Format.fprintf fmt "0%a" (print_in_base 8 None) n
+          | ILitDec | ILitUnk ->
+             (* default to base 10 *)
+             Format.fprintf fmt "%a" (print_in_base 10 None) n in
+        let s = match e.e_ity with
         | I i ->
-             begin match (ty_of_ity i).ty_node with
-             | Tyapp ({ts_def = Range { ir_lower = l; ir_upper = h }},_) ->
-                let open BigInt in
-                let unsigned = eq l zero in
-                if (le min32 l) && (le h max32) then ""
-                else if unsigned && (le h maxu32) then "u"
-                else if (le min64 l) && (le h max64) then "l"
-                else if unsigned && (le h maxu64) then "ul"
-                else raise (Unsupported "unknown number format")
-             | _ ->  raise (Unsupported "non-range integer constant") end
+           let ts = match (ty_of_ity i) with
+             | { ty_node = Tyapp (ts, []) } -> ts
+             | _ -> assert false in
+           begin match query_syntax info.literal ts.ts_name with
+           | Some st ->
+              Format.asprintf "%a" (syntax_range_literal ~cb:(Some print) st) ic
+           | _ ->
+              let s = ts.ts_name.id_string in
+              raise (Unsupported ("unspecified number format for type "^s)) end
         | _ -> assert false in
-        let e = C.(Econst (Cint (n^suf))) in
+        let e = C.(Econst (Cint s)) in
         ([], expr_or_return env e)
     | Eapp (rs, el)
          when is_struct_constructor info rs

src/util/number.ml

@@ -188,7 +188,7 @@ let print_in_base radix digits fmt i =
       let d,m = BigInt.euclidean_div_mod i radix in
       aux (digits - 1) d;
       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 =
   BigInt.to_int i.il_int