Following along from @ninjaaron 's ports of a couple of my Perl scripts to OCaml, and then @Frederic_Loyer 's pointing me at ppx_regexp, I decided to write some more “perl-ish” regexp PPX rewriters, and use 'em to port some Perl scripts. So: GitHub - camlp5/pa_ppx_perl: Camlp5-compatible PPX rewriters for Perl idioms .
I’ve implemented a few PPX extensions: match, split, pattern, subst, and tried to come up with a syntax that’s as much like the Perl regexp integration as possible. I’d be interested in any comments or suggestions.
As examples, I used 'em to rewrite ya_wrap_ocamlfind.ml (@ninjaaron 's OCaml version) a little – replacing the regexp bits:
(** -syntax camlp5o *)
let rec split_args cmd = function
| "--" :: files -> List.rev cmd, files
| [file] -> List.rev cmd, [file]
| arg :: args -> split_args (arg :: cmd) args
| [] -> failwith "please supply input arguments"
let split_args = split_args []
let envsubst s =
let envlookup vname =
match Sys.getenv_opt vname with
Some v -> v
| None -> failwith [%pattern {|ya_wrap_ocamlfind: environment variable <<${vname}>> not found|}] in
let f s1 s2 =
if s1 <> "" then envlookup s1
else if s2 <> "" then envlookup s2
else assert false in
[%subst {|(?:\$\(([^)]+)\)|\$\{([^}]+)\})|} / {| f $1$ $2$ |} / g e] s
let discover_args f =
let f' = open_in f in
let line1 = input_line f' in
close_in f';
match [%match {|^\(\*\*(.*?)\*\)|} / strings] line1 with
| None -> ""
| Some (_, Some params) -> envsubst params
let () =
let cmd, files =
Array.to_list Sys.argv |> List.tl |> split_args in
let cmd = Filename.quote_command (List.hd cmd) (List.tl cmd) in
List.iter (fun f ->
let extra = discover_args f in
let cmd = [%pattern {|${cmd} ${extra} ${f}|}] in
Printf.fprintf stderr "%s\n%!" cmd;
ignore (Sys.command cmd))
files
and then I did the same to another script, META.pl that I use to bash on auto-generated META files. The idea is, when doing a “local build” of a project, I install the files into a local-install directory. If the project (say, pa_ppx_perl) has two subdirectories (say, pa_perl and runtime) that produces two findlib packages (say, pa_ppx_perl and pa_ppx_perl_runtime). So I generate META files for these (with proper version numbers). Then when I want to install in a system-wide location, I want the package-names to be pa_ppx_perl and pa_ppx_perl.runtime (notice “_” turns into “.”).
META.pl accomplishes that little bit of hacking. For a small project with two subdirs, it’s maybe overkill, but for pa_ppx (with 17 subdirs, it starts to be useful). So below I attach the Perl program, and then the OCaml program (nearly finished).
Perl:
#!/usr/bin/env perl
use strict ;
use IPC::System::Simple qw(systemx runx capturex $EXITVAL);
use String::ShellQuote ;
use File::Basename;
use Version ;
our %pkgmap = (
'pa_ppx_perl_runtime' => 'pa_ppx_perl.runtime',
'pa_ppx_perl' => 'pa_ppx_perl',
);
{
my $perlmeta = indent(2, fixdeps(capturex("./pa_perl/META.pl"))) ;
my $rtmeta = indent(2, fixdeps(capturex("./runtime/META.pl"))) ;
print <<"EOF";
$perlmeta
package "runtime" (
$rtmeta
)
EOF
}
sub fixdeps {
my $txt = join('', @_) ;
$txt =~ s,^(.*require.*)$, fix0($1) ,mge;
return $txt ;
}
sub fix0 {
my $txt = shift ;
$txt =~ s,"([^"]+)", '"'. fix($1) .'"' ,e;
return $txt ;
}
sub fix {
my $txt = shift ;
my @l = split(/,/,$txt);
my @ol = () ;
foreach my $p (@l) {
$p =~ s,^([^.]+), $pkgmap{$1} || $1 ,e ;
push(@ol, $p);
}
$txt = join(',', @ol) ;
return $txt ;
}
sub indent {
my $n = shift ;
my $txt = shift ;
my $pfx = ' ' x $n ;
$txt =~ s,^,$pfx,gm;
return $txt ;
}
OCaml:
(** -syntax camlp5o *)
open Pa_ppx_utils
let pkgmap = [
"pa_ppx_perl_runtime","pa_ppx_perl.runtime"
; "pa_ppx_perl","pa_ppx_perl"
]
let indent n txt =
let pfx = String.make n ' ' in
[%subst {|^|} / {|${pfx}|} / g m] txt
let fix txt =
let l = [%split {|\s*,\s*|}] txt in
let f s =
match List.assoc s pkgmap with
exception Not_found -> s
| v -> v in
let ol =
l
|> List.map (fun p ->
[%subst {|^([^.]+)|} / {| f $1$ |} / e] p
) in
String.concat "," ol
let fix0 txt =
[%subst {|"([^"]+)"|} / {| "\"" ^ fix($1$) ^ "\"" |} / e] txt
let fixdeps txt =
[%subst {|^(.*require.*)$|} / {| fix0($1$) |} / m g e] txt
let capturex (cmd, args) =
let channel = Unix.open_process_args_in cmd args in
let txt = Std.read_ic_fully ~channel () in
close_in channel ;
txt
let perlmeta = indent 2 (fixdeps(capturex("./pa_perl/META.pl",[||]))) ;;
let rtmeta = indent 2 (fixdeps(capturex("./runtime/META.pl",[||]))) ;;
print_string [%pattern {|${perlmeta}
package "runtime" (
${rtmeta}
)
|}]
