Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion bin/dune
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
(executable
(public_name sgen)
(name sgen)
(libraries stellogen base cmdliner))
(libraries stellogen base cmdliner unix))

(env
(dev
Expand Down
91 changes: 90 additions & 1 deletion bin/sgen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,82 @@ let run input_file =
| Ok error_msg -> Stdlib.Printf.eprintf "%s" error_msg
| Error _ -> () )

let run_with_timeout input_file timeout =
let pid = Unix.fork () in
if pid = 0 then (
(* Child process *)
try
run input_file;
Stdlib.exit 0
with e ->
Stdlib.Printf.eprintf "Error: %s\n" (Exn.to_string e);
Stdlib.exit 1 )
else
(* Parent process *)
let start_time = Unix.time () in
let rec wait_with_timeout () =
let elapsed = Unix.time () -. start_time in
if Float.(elapsed > timeout) then (
(* Timeout - kill child process *)
Unix.kill pid Stdlib.Sys.sigkill;
let _ = Unix.waitpid [] pid in
Stdlib.Printf.eprintf
"\n[Timeout: execution exceeded %.1fs - killed]\n%!" timeout;
false )
else
match Unix.waitpid [ Unix.WNOHANG ] pid with
| 0, _ ->
(* Still running *)
Unix.sleepf 0.1;
wait_with_timeout ()
| _, status -> (
match status with
| Unix.WEXITED 0 -> true
| Unix.WEXITED code ->
Stdlib.Printf.eprintf "[Exited with code %d]\n%!" code;
false
| Unix.WSIGNALED signal ->
Stdlib.Printf.eprintf "[Killed by signal %d]\n%!" signal;
false
| Unix.WSTOPPED signal ->
Stdlib.Printf.eprintf "[Stopped by signal %d]\n%!" signal;
false )
in
wait_with_timeout ()

let watch input_file timeout =
let abs_path =
if Stdlib.Filename.is_relative input_file then
Stdlib.Filename.concat (Stdlib.Sys.getcwd ()) input_file
else input_file
in

Stdlib.Printf.printf "Watching %s (timeout: %.1fs)\n%!" abs_path timeout;
Stdlib.Printf.printf "Press Ctrl+C to stop.\n\n%!";

(* Initial run *)
let _ = run_with_timeout input_file timeout in

(* Polling approach - check file modification time *)
let rec poll_loop last_mtime =
Unix.sleepf 0.5;
try
let stat = Unix.stat abs_path in
let current_mtime = stat.Unix.st_mtime in
if Float.(current_mtime > last_mtime) then (
Stdlib.Printf.printf "\n\n--- File changed, re-running ---\n%!";
let _ = run_with_timeout input_file timeout in
poll_loop current_mtime )
else poll_loop last_mtime
with Unix.Unix_error _ ->
Stdlib.Printf.eprintf "Error accessing file, retrying...\n%!";
Unix.sleepf 1.0;
poll_loop last_mtime
in

let initial_stat = Unix.stat abs_path in
poll_loop initial_stat.Unix.st_mtime

let preprocess_only input_file =
let expr = parse input_file in
let preprocessed = Expr.preprocess expr in
Expand All @@ -49,8 +125,21 @@ let preprocess_cmd =
in
Cmd.v (Cmd.info "preprocess" ~doc) term

let timeout_arg =
let doc = "Timeout in seconds for each execution (default: 5.0)" in
Arg.(value & opt float 5.0 & info [ "t"; "timeout" ] ~docv:"SECONDS" ~doc)

let watch_cmd =
let doc = "Watch and re-run the Stellogen program on file changes" in
let term =
Term.(
const (fun input timeout -> wrap (fun i -> watch i timeout) input)
$ input_file_arg $ timeout_arg |> term_result )
in
Cmd.v (Cmd.info "watch" ~doc) term

let default_cmd =
let doc = "Stellogen: code generator and evaluator" in
Cmd.group (Cmd.info "sgen" ~doc) [ run_cmd; preprocess_cmd ]
Cmd.group (Cmd.info "sgen" ~doc) [ run_cmd; preprocess_cmd; watch_cmd ]

let () = Stdlib.exit (Cmd.eval default_cmd)
Loading