open Syntax
open Ast
-open Whenutils
-
let unique = let i = ref 0 in fun () -> incr i; !i
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,
(* Handle a top level statement. *)
let rec call_stmt name (_loc, stmt, sh) =
- let name = if name <> "" then name else unique_job_name () in
- let name = <:expr< $str:name$ >> in
+ let name =
+ match name with
+ | None -> let name = unique_job_name () in <:expr< $str:name$ >>
+ | Some name -> name in
match stmt with
| `When e -> when_stmt _loc name e sh
| `Every p -> every_stmt _loc name p sh
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$;
+ <:expr< { Whenexpr.sh_loc = $loc$;
sh_script = $str:sh$ } >>
in
Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander;
Stream.junk stream;
(match Stream.next stream with
| KEYWORD ("sec"|"secs"|"second"|"seconds"), _ ->
- <:expr< Whenutils.Every_seconds $`int:i$ >>
+ <:expr< Whenexpr.Every_seconds $`int:i$ >>
| KEYWORD ("min"|"mins"|"minute"|"minutes"), _ ->
let i = 60 * i in
- <:expr< Whenutils.Every_seconds $`int:i$ >>
+ <:expr< Whenexpr.Every_seconds $`int:i$ >>
| KEYWORD ("hour"|"hours"), _ ->
let i = 3600 * i in
- <:expr< Whenutils.Every_seconds $`int:i$ >>
+ <:expr< Whenexpr.Every_seconds $`int:i$ >>
| KEYWORD ("day"|"days"), _ ->
- <:expr< Whenutils.Every_days $`int:i$ >>
+ <:expr< Whenexpr.Every_days $`int:i$ >>
| KEYWORD ("week"|"weeks"), _ ->
let i = 7 * i in
- <:expr< Whenutils.Every_days $`int:i$ >>
+ <:expr< Whenexpr.Every_days $`int:i$ >>
| KEYWORD ("month"|"months"), _ ->
- <:expr< Whenutils.Every_months $`int:i$ >>
+ <:expr< Whenexpr.Every_months $`int:i$ >>
| KEYWORD ("year"|"years"), _ ->
- <:expr< Whenutils.Every_years $`int:i$ >>
+ <:expr< Whenexpr.Every_years $`int:i$ >>
| KEYWORD ("decade"|"decades"), _ ->
let i = 10 * i in
- <:expr< Whenutils.Every_years $`int:i$ >>
+ <:expr< Whenexpr.Every_years $`int:i$ >>
| KEYWORD ("century"|"centuries"|"centurys"), _ ->
let i = 100 * i in
- <:expr< Whenutils.Every_years $`int:i$ >>
+ <:expr< Whenexpr.Every_years $`int:i$ >>
| KEYWORD ("millenium"|"millenia"|"milleniums"), _ ->
let i = 1000 * i in
- <:expr< Whenutils.Every_years $`int:i$ >>
+ <:expr< Whenexpr.Every_years $`int:i$ >>
| (KEYWORD s | LIDENT s), _ ->
eprintf "period: failed to parse %d %s\n%!" i s;
raise Stream.Failure
)
| _ -> raise Stream.Failure
)
-
-(*
-(* This hand-written parser looks for "job <name>" before a statement. *)
-let optjob =
- Gram.Entry.of_parser "optjob"
- (fun stream ->
- let info, name =
- match Stream.npeek 2 stream with
- | [ LIDENT "job", info; STRING (_,name), _ ] ->
- Stream.junk stream;
- Stream.junk stream;
- info, name
- | (_, info) :: _ ->
- (* Job is unnamed so generate a unique internal name. *)
- info, unique_job_name ()
- | _ -> assert false in
- let _loc = Gram.token_location info in
- <:expr< $str:name$ >>
- )
-*)
;;
EXTEND Gram
(* A period expression (used in "every"). *)
periodexpr: [
[ ["sec"|"secs"|"second"|"seconds"] ->
- <:expr< Whenutils.Every_seconds 1 >> ]
+ <:expr< Whenexpr.Every_seconds 1 >> ]
| [ ["min"|"mins"|"minute"|"minutes"] ->
- <:expr< Whenutils.Every_seconds 60 >> ]
- | [ ["hour"|"hours"] -> <:expr< Whenutils.Every_seconds 3600 >> ]
- | [ ["day"|"days"] -> <:expr< Whenutils.Every_days 1 >> ]
- | [ ["week"|"weeks"] -> <:expr< Whenutils.Every_days 7 >> ]
- | [ ["month"|"months"] -> <:expr< Whenutils.Every_months 1 >> ]
- | [ ["year"|"years"] -> <:expr< Whenutils.Every_years 1 >> ]
- | [ ["decade"|"decades"] -> <:expr< Whenutils.Every_years 10 >> ]
+ <:expr< Whenexpr.Every_seconds 60 >> ]
+ | [ ["hour"|"hours"] -> <:expr< Whenexpr.Every_seconds 3600 >> ]
+ | [ ["day"|"days"] -> <:expr< Whenexpr.Every_days 1 >> ]
+ | [ ["week"|"weeks"] -> <:expr< Whenexpr.Every_days 7 >> ]
+ | [ ["month"|"months"] -> <:expr< Whenexpr.Every_months 1 >> ]
+ | [ ["year"|"years"] -> <:expr< Whenexpr.Every_years 1 >> ]
+ | [ ["decade"|"decades"] -> <:expr< Whenexpr.Every_years 10 >> ]
| [ ["century"|"centuries"|"centurys"] ->
- <:expr< Whenutils.Every_years 100 >> ]
+ <:expr< Whenexpr.Every_years 100 >> ]
| [ ["millenium"|"millenia"|"milleniums"] ->
- <:expr< Whenutils.Every_years 1000 >> ]
+ <:expr< Whenexpr.Every_years 1000 >> ]
| [ e = period_parser -> e ]
];
(* "str_item" is a top level statement in an OCaml program. *)
str_item: LEVEL "top" [
- [ s = statement -> call_stmt "" s ]
- | [ "job"; name = STRING; s = statement -> call_stmt name s ]
+ [ s = statement -> call_stmt None s ]
+ | [ "job"; name = expr; s = statement -> call_stmt (Some name) s ]
];
END
git.annexia.org / whenjobs.git / blobdiff