@@ -24,6 +24,85 @@ let run input_file =
2424    |  Ok  error_msg  -> Stdlib.Printf. eprintf " %s" 
2525    |  Error  _  -> ()  )
2626
27+ let  run_with_timeout  input_file  timeout  = 
28+   let  pid =  Unix. fork ()  in 
29+   if  pid =  0  then  (
30+     (*  Child process *) 
31+     try  run input_file; Stdlib. exit 0 
32+     with  e  -> 
33+       Stdlib.Printf. eprintf " Error: %s\n " Exn. to_string e);
34+       Stdlib. exit 1 
35+   ) else  (
36+     (*  Parent process *) 
37+     let  start_time =  Unix. time ()  in 
38+     let  rec  wait_with_timeout  ()  = 
39+       let  elapsed =  Unix. time ()  -.  start_time in 
40+       if  Float. (elapsed >  timeout) then  (
41+         (*  Timeout - kill child process *) 
42+         Unix. kill pid Stdlib.Sys. sigkill;
43+         let  _ =  Unix. waitpid []  pid in 
44+         Stdlib.Printf. eprintf " \n [Timeout: execution exceeded %.1fs - killed]\n %!" 
45+         false 
46+       ) else  (
47+         match  Unix. waitpid [Unix. WNOHANG ] pid with 
48+         |  0 , _  ->
49+           (*  Still running *) 
50+           Unix. sleepf 0.1 ;
51+           wait_with_timeout () 
52+         |  _ , status  -> (
53+           match  status with 
54+           |  Unix. WEXITED  0  -> true 
55+           |  Unix. WEXITED  code  ->
56+             Stdlib.Printf. eprintf " [Exited with code %d]\n %!" 
57+             false 
58+           |  Unix. WSIGNALED  signal  ->
59+             Stdlib.Printf. eprintf " [Killed by signal %d]\n %!" 
60+             false 
61+           |  Unix. WSTOPPED  signal  ->
62+             Stdlib.Printf. eprintf " [Stopped by signal %d]\n %!" 
63+             false 
64+         )
65+       )
66+     in 
67+     wait_with_timeout () 
68+   )
69+ 
70+ let  watch  input_file  timeout  = 
71+   let  abs_path = 
72+     if  Stdlib.Filename. is_relative input_file then 
73+       Stdlib.Filename. concat (Stdlib.Sys. getcwd () ) input_file
74+     else 
75+       input_file
76+   in 
77+ 
78+   Stdlib.Printf. printf " Watching %s (timeout: %.1fs)\n %!" 
79+   Stdlib.Printf. printf " Press Ctrl+C to stop.\n\n %!" 
80+ 
81+   (*  Initial run *) 
82+   let  _ =  run_with_timeout input_file timeout in 
83+ 
84+   (*  Polling approach - check file modification time *) 
85+   let  rec  poll_loop  last_mtime  = 
86+     Unix. sleepf 0.5 ;
87+     try 
88+       let  stat =  Unix. stat abs_path in 
89+       let  current_mtime =  stat.Unix. st_mtime in 
90+       if  Float. (current_mtime >  last_mtime) then  (
91+         Stdlib.Printf. printf " \n\n --- File changed, re-running ---\n %!" 
92+         let  _ =  run_with_timeout input_file timeout in 
93+         poll_loop current_mtime
94+       ) else 
95+         poll_loop last_mtime
96+     with 
97+     |  Unix. Unix_error  _  ->
98+       Stdlib.Printf. eprintf " Error accessing file, retrying...\n %!" 
99+       Unix. sleepf 1.0 ;
100+       poll_loop last_mtime
101+   in 
102+ 
103+   let  initial_stat =  Unix. stat abs_path in 
104+   poll_loop initial_stat.Unix. st_mtime
105+ 
27106let  preprocess_only  input_file  = 
28107  let  expr =  parse input_file in 
29108  let  preprocessed =  Expr. preprocess expr in 
@@ -49,8 +128,19 @@ let preprocess_cmd =
49128  in 
50129  Cmd. v (Cmd. info " preprocess" ~doc ) term
51130
131+ let  timeout_arg = 
132+   let  doc =  " Timeout in seconds for each execution (default: 5.0)" in 
133+   Arg. (value &  opt float  5.0  &  info [" t" " timeout" ~docv: " SECONDS" ~doc )
134+ 
135+ let  watch_cmd = 
136+   let  doc =  " Watch and re-run the Stellogen program on file changes" in 
137+   let  term = 
138+     Term. (const (fun  input  timeout  -> wrap (fun  i  -> watch i timeout) input) $  input_file_arg $  timeout_arg |>  term_result)
139+   in 
140+   Cmd. v (Cmd. info " watch" ~doc ) term
141+ 
52142let  default_cmd = 
53143  let  doc =  " Stellogen: code generator and evaluator" in 
54-   Cmd. group (Cmd. info " sgen" ~doc ) [ run_cmd; preprocess_cmd ]
144+   Cmd. group (Cmd. info " sgen" ~doc ) [ run_cmd; preprocess_cmd; watch_cmd  ]
55145
56146let  ()  =  Stdlib. exit (Cmd. eval default_cmd)
0 commit comments