Janestreet/ppx_string that works with Out_channel?

Is there a variant of GitHub - janestreet/ppx_string: ppx extension for string interpolation that works with Out_channel (stdio.Stdio.Out_channel) ?

Here is what I meant. Let us look at the ppx_string example:

let script_remotely (user : string) (host : string) (port : int) (script : string) =
  [%string "ssh %{user}@%{host} -p %{port#Int} %{Sys.quote script}"]

let script_remotely (user : string) (host : string) (port : int) (script : string) =
  String.concat ""
    [ "ssh "
    ; user
    ; "@"
    ; host
    ; " -p "
    ; Int.to_string port
    ; " "
    ; Sys.quote script
    ]

So (1) the individual components are string and (2) we concat it to form a string.

I want something different. I want something where (1) the individual components are Out_channel -> unit, and we sequence them to form a Out_channel -> unit.

The context here: I’m trying to build something that takes as input an AST and converts it to a string to write to a file. I’d prefer to not do string concats at every stage, and instead at every step have it dump into the Out_channel.

Thanks!

I was bored, so I decided to hack on your little problem a little. Imagine that we have a type "dest"s. So you can have a “string dest” or a “file dest” (maybe other kinds). Then the expansion of [%string ...] would invoke operations from the dest, and not just do String.concat. And then your little problem … solves itself.

I think it should be straightforward to write a PPX rewriter that is like ppx_string, but does this sort of thing instead. Also though, I wonder if somebody or some package already has the equivalent of these "dest"s. No idea, but it seems so obviously useful …


type 'a dest_t = (string -> unit) * (unit -> 'a) ;;

let string_dest () : string dest_t =
let b = Buffer.create 32 in
let send s = Buffer.add_string b s in
let finish () = Buffer.contents b in
(send, finish) ;;

let file_dest oc : unit dest_t =
let send s = output_string oc s in
let finish () = flush oc ; () in
(send, finish)
;;

let script_remotely (user : string) (host : string) (port : int) (script : string) (send, finish) =
    send "ssh " ;
    send user ;
    send "@" ;
    send host ;
    send " -p " ;
    send (Int.to_string port) ;
    send " " ;
    send (Printf.sprintf "%S" script) ;
    finish()
;;

script_remotely "u" "h" 8080 "a b c"  (string_dest());;
script_remotely "u" "h" 8080 "a b c"  (file_dest stdout);;

ETA: fixed last two lines. Um, I think. I closed the emacs and threw away the buffer, so I don’t have the actual code I was running. But I think that this is right.

1 Like

If and when I implement this (as part of pa_ppx_regexp) (b/c I think your idea is a useful one), I’d use three PPX extensions: string to produce a string, output that yields a function of type out_channel -> unit, and format that yields a function of type 'a dest_t -> 'a .