C code generation for printf

compiler/global/global_printer.ml

@@ -62,7 +62,7 @@ let rec print_static_exp_desc ff sed = match sed with
   | Sint i -> fprintf ff "%d" i
   | Sbool b -> fprintf ff "%b" b
   | Sfloat f -> fprintf ff "%f" f
-  | Sstring s -> fprintf ff "\"%s\"" s
+  | Sstring s -> fprintf ff "\"%s\"" (String.escaped s)
   | Sconstructor ln -> print_qualname ff ln
   | Sfield ln -> print_qualname ff ln
   | Svar id -> fprintf ff "%a" print_qualname id

compiler/heptagon/analysis/typing.ml

@@ -57,6 +57,7 @@ type error =
   | Esplit_enum of ty
   | Esplit_tuple of ty
   | Eenable_memalloc
+  | Ebad_format
   | Eformat_string_not_constant
 
 exception Unify
@@ -201,6 +202,10 @@ let message loc kind =
         "%aThis function was compiled with linear types. \
                Enable linear typing to call it.@."
           print_location loc
+    | Ebad_format ->
+      eprintf
+        "%aThe format string is invalid@."
+          print_location loc
     | Eformat_string_not_constant ->
       eprintf
         "%aA static format string was expected@."
@@ -990,8 +995,11 @@ and typing_format_args cenv h e args =
     | Econst { se_desc = Sstring s } -> s
     | _ -> raise (TypingError Eformat_string_not_constant)
   in
-  let expected_ty_list = Printf_parser.extract_formatters s in
-  typing_args cenv h expected_ty_list args
+  try
+    let expected_ty_list = Printf_parser.types_of_format_string s in
+    typing_args cenv h expected_ty_list args
+  with
+    | Printf_parser.Bad_format -> raise (TypingError Ebad_format)
 
 let rec typing_pat h acc = function
   | Evarpat(x) ->

compiler/main/mls2obc.ml

@@ -464,6 +464,12 @@ let rec translate_eq map call_context ({ Minils.eq_lhs = pat; Minils.eq_rhs = e
         let action = mk_ifthenelse cond true_act false_act in
         v, si, j, (control map ck action) :: s
 
+    | pat, Minils.Eapp({ Minils.a_op =
+        Minils.Efun ({ qual = Module "Iostream"; name = "printf" | "fprintf" } as q)},
+                       args, _) ->
+      let action = Aop (q, List.map (translate_extvalue_to_exp map) args) in
+      v, si, j, (control map ck action) :: s
+
     | pat, Minils.Eapp ({ Minils.a_op = Minils.Efun _ | Minils.Enode _ } as app, e_list, r) ->
         let name_list = translate_pat map e.Minils.e_ty pat in
         let c_list = List.map (translate_extvalue_to_exp map) e_list in

compiler/obc/c/c.ml

@@ -277,7 +277,7 @@ and pp_cconst fmt cconst = match cconst with
   | Ccint i -> fprintf fmt "%d" i
   | Ccfloat f -> fprintf fmt "%f" f
   | Ctag t -> pp_string fmt t
-  | Cstrlit t -> fprintf fmt "\"%s\"" t
+  | Cstrlit t -> fprintf fmt "\"%s\"" (String.escaped t)
 
 let pp_cdecl fmt cdecl = match cdecl with
   | Cdecl_enum (s, sl) ->

compiler/obc/c/cgen.ml

@@ -112,6 +112,16 @@ let copname = function
   | ">>>" -> ">>" | "<<<" -> "<<" | "&&&" -> "&" | "|||" -> "|"
   | op   -> op
 
+
+let cformat_of_format s =
+  let aux m = match m with
+    | "b" -> "d" (*no booleans in C*)
+    | _ -> m
+  in
+  match s with
+    | Cconst (Cstrlit s) -> Cconst (Cstrlit (Printf_parser.tr_format aux s))
+    | _ -> assert false
+
 (** Translates an Obc var_dec to a tuple (name, cty). *)
 let cvar_of_vd vd =
   name vd.v_ident, ctype_of_otype vd.v_type
@@ -279,6 +289,14 @@ and cop_of_op_aux op_name cexps = match op_name with
               Cbop (copname op, el, er)
           | _ -> Cfun_call(op, cexps)
         end
+    | { qual = Module "Iostream"; name = "printf" } ->
+      let s, args = assert_1min cexps in
+      let s = cformat_of_format s in
+      Cfun_call("printf", s::args)
+    | { qual = Module "Iostream"; name = "fprintf" } ->
+      let file, s, args = assert_2min cexps in
+      let s = cformat_of_format s in
+      Cfun_call("fprintf", file::s::args)
     | { name = op } -> Cfun_call(op,cexps)
 
 and cop_of_op out_env var_env op_name exps =
@@ -801,9 +819,13 @@ let cdefs_and_cdecls_of_program_decl id = match id with
   | Pconst cd -> cdefs_and_cdecls_of_const_decl cd
   | _ -> [], []
 
+let header_of_module m = match m with
+  | Module "Iostream" -> "stdio"
+  | _ -> String.uncapitalize (modul_to_string m)
+
 let global_file_header name prog =
   let dependencies = ModulSet.elements (Obc_utils.Deps.deps_program prog) in
-  let dependencies = List.map (fun m -> String.uncapitalize (modul_to_string m)) dependencies in
+  let dependencies = List.map header_of_module dependencies in
 
   let classes = program_classes prog in
   let (decls, defs) =
@@ -829,8 +851,7 @@ let global_file_header name prog =
 
 let interface_header name i =
   let dependencies = ModulSet.elements (Obc_utils.Deps.deps_interface i) in
-  let dependencies =
-    List.map (fun m -> String.uncapitalize (modul_to_string m)) dependencies in
+  let dependencies = List.map header_of_module dependencies in
 
   let cdefs_and_cdecls = List.map cdefs_and_cdecls_of_interface_decl i.i_desc in
 

compiler/utilities/global/printf_parser.ml

@@ -2,20 +2,42 @@ open Types
 
 exception Bad_format
 
+type token = Modifier of string | Literal of string
+type format = token list
+
 let tail s start =
   String.sub s start (String.length s - start)
 
 (** Return a list of expected types from a format string *)
-let rec extract_formatters s =
+let rec format_of_string s =
   try
     let i = String.index s '%' in
-    let ty = match s.[i+1] with
-      | 'b' -> Initial.tbool
-      | 'd' -> Initial.tint
-      | 'f' -> Initial.tfloat
-      | _ -> raise Bad_format
-    in
-    ty::(extract_formatters (tail s (i+1)))
+    let l = format_of_string (tail s (i+2)) in
+    if i = 0 then
+      let modifier = String.sub s 0 1 in
+      (Modifier modifier)::l
+    else
+      let lit = String.sub s 0 i in
+      let modifier = String.sub s (i+1) 1 in
+      (Literal lit)::(Modifier modifier)::l
   with
     | Invalid_argument _ -> raise Bad_format (* String.get failed*)
-    | Not_found -> []
+    | Not_found -> [Literal s]
+
+let types_of_format_string s =
+  let ty_of_format f acc = match f with
+    | Modifier "b" -> Initial.tbool::acc
+    | Modifier "d" -> Initial.tint::acc
+    | Modifier "f" -> Initial.tfloat::acc
+    | _ -> acc
+  in
+  let sl = format_of_string s in
+  List.fold_right ty_of_format sl []
+
+let tr_format f s =
+  let aux tok acc = match tok with
+    | Literal s -> s^acc
+    | Modifier m -> "%"^(f m)^acc
+  in
+  let sl = format_of_string s in
+  List.fold_right aux sl ""

test/good/format.ept

@@ -4,8 +4,8 @@ unsafe fun f(a:int) returns (o:int)
 var x:int;
 let
   x = a + 2;
-  () = printf("Int is %d@.", x);
-  () = printf("Bool is %b@.", x = 0);
-  () = printf("Test");
+  () = printf("Int is %d\n", x);
+  () = printf("Bool is %b\n", x = 0);
+  () = printf("Test\n");
   o = x - 1;
 tel