pa_when: Allow >> in scripts to be escaped as >\>.

diff --git a/lib/pa_when.ml b/lib/pa_when.ml
index 3b8f36e..0d16469 100644 (file)
--- a/lib/pa_when.ml
+++ b/lib/pa_when.ml
@@ -33,6 +33,36 @@ let unique = let i = ref 0 in fun () -> incr i; !i
 
 let unique_job_name () = sprintf "job$%d" (unique ())
 
 
 let unique_job_name () = sprintf "job$%d" (unique ())
 

+let rec find s sub =
+  let len = String.length s in
+  let sublen = String.length sub in
+  let rec loop i =
+    if i <= len-sublen then (
+      let rec loop2 j =
+        if j < sublen then (
+          if s.[i+j] = sub.[j] then loop2 (j+1)
+          else -1
+        ) else
+          i (* found *)
+      in
+      let r = loop2 0 in
+      if r = -1 then loop (i+1) else r
+    ) else
+      -1 (* not found *)
+  in
+  loop 0
+
+let rec replace_str s s1 s2 =
+  let len = String.length s in
+  let sublen = String.length s1 in
+  let i = find s s1 in
+  if i = -1 then s
+  else (
+    let s' = String.sub s 0 i in
+    let s'' = String.sub s (i+sublen) (len-i-sublen) in
+    s' ^ s2 ^ replace_str s'' s1 s2
+  )
+

 (* Convert a _loc to an AST. *)
 let expr_of_loc _loc loc =
   let file_name,
 (* Convert a _loc to an AST. *)
 let expr_of_loc _loc loc =
   let file_name,


@@ -87,8 +117,8 @@ let () =
   let sh_quotation_expander _loc _ sh =
     let loc = expr_of_loc _loc _loc in
 
   let sh_quotation_expander _loc _ sh =
     let loc = expr_of_loc _loc _loc in
 

-    (* XXX Expand %- or $- expressions in code. *)
-    (* XXX Escape >> in code. *)
+    (* Convert ">\>" to ">>" in code. *)
+    let sh = replace_str sh ">\\>" ">>" in

 
     <:expr< { Whenutils.sh_loc = $loc$;
               sh_script = $str:sh$ } >>
 
     <:expr< { Whenutils.sh_loc = $loc$;
               sh_script = $str:sh$ } >>