Re: [Caml-list] Extending Format strings

[Alain Frisch <alain@frisch.fr>]

On 07/01/2014 05:27 PM, Jeremie Dimino wrote:
> On Tue, Jul 1, 2014 at 10:59 AM, Gabriel Kerneis <gabriel@kerneis.info
> <mailto:gabriel@kerneis.info>> wrote:
>
>     Dear all,
>
>     in CIL <http://cil.sf.net>, the module Pretty provides a Format-like
>     interface with a few extensions compared to usual format strings.
>     Implementation-wise, it uses string_of_format and re-implements most of
>     the logic of the pre-4.02 Format module, with Obj.magic all over the
>     place.
>
>     I wondered if anyone has done something similar in their own project
>     (extending Format in one way or another), and if the new GADT-based
>     approach could provide a cleaner solution?
>
>     One thing I quite like with the current code, despite its uglyness, is
>     its concision. I am right in assuming that switching to GADTs would
>     require a lot more boilerplate?
>
>
> I had a quick look at [Pretty.dprintf] and I think you could use
> [CamlinternalFormat.make_printf] to implement it with 4.02. @-sequences
> are already recognized by the format parser in the compiler, but it
> should be compatible with [Pretty]'s syntax, you just have to interpret
> the constructors differently. It should actually make the code of
> [Pretty.dprintf] much simpler.

We had a very similar issue with some internal LexiFi library, also 
using @-markers, and returning some structured document.  Jeremie's 
suggestion works very well.

The code below won't compile, but it can give you an idea on how to proceed:


let printf_k fmt_s (acc : (unit, t) CamlinternalFormat.acc) =
   let open CamlinternalFormat in
   let l = ref empty in
   let add x = l := conc !l x in
   let stack = ref [] in
   let push x = stack := (x,!l) :: !stack; l := empty in
   let err () =
     Mlfi_isdatypes.ffailwith "Mlfi_pp.printf: invalid format string %S" 
fmt_s
   in
   let pop () = match !stack with
     | (x,old) :: st -> stack := st; let nl = !l in l := old; (x,nl)
     | _ -> err ()
   in
   let rec k = function
     | Acc_string(p, s) -> k p; add (str s)
     | Acc_char(p, c) -> k p; add (str (String.make 1 c))
     | Acc_delay(p, f) -> k p; add f
     | Acc_flush p -> k p
     | Acc_invalid_arg (_, msg) -> invalid_arg msg
     | Acc_formatting_lit (p, lit) ->
         k p;
         begin match string_of_formatting_lit lit with
         | "@[" -> push (`BoxLeft 2)
         | "@]" ->
             begin match pop () with
             | (`BoxLeft k,u) -> add (indent k u)
             | _ -> err ()
             end
         | "@<" -> push `LineLeft
         | "@>" ->
             begin match pop () with
             | `LineLeft, u -> add (line u)
             | _ -> err ()
             end
         | s ->
             add (str s)
         end
     | Acc_formatting_gen (p, _) -> k p
     | End_of_acc -> ()
   in
   k acc;
   if !stack <> [] then err ();
   !l

let printf (Format (fmt, fmt_s) : ('a, unit, t, f) format4) : 'a =
   let open CamlinternalFormat in
   make_printf (fun () acc -> printf_k fmt_s acc) () End_of_acc fmt


-- Alain