diff --git a/bin/dune b/bin/dune index a4388db..6f927e8 100644 --- a/bin/dune +++ b/bin/dune @@ -1,7 +1,7 @@ (executable (public_name sgen) (name sgen) - (libraries stellogen base cmdliner)) + (libraries stellogen base cmdliner unix)) (env (dev diff --git a/bin/sgen.ml b/bin/sgen.ml index 30c7ac3..d2260c3 100644 --- a/bin/sgen.ml +++ b/bin/sgen.ml @@ -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 @@ -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)