caml-urm

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

open List

let usage () =
  Printf.printf "USAGE: urm FILE [-i ITERS] [-RN=V...] [-RN...] \n";
  Printf.printf "See urm.1 for additional information\n"

let default_max_iters = 1073741824

(** Execute the program from [file] with initial register values given by
    [regs] and the maximum number of allowed iterations set to [iters] *)
let main iters init_m regs_prints file =
  let contents = really_input_string file (in_channel_length file) in
  try
    let program = Urm.parse contents in
    match Urm.nexec iters program init_m with
    | Some m ->
      List.iter (fun n -> Printf.printf "R%d = %d\n" n (Urm.register m n))
                regs_prints
    | None ->
      Printf.eprintf
        "ERROR: the input program did not halt after %d iterations\n"
        iters;
      Printf.eprintf "The input program may not halt\n";
      exit 1
  with Urm.Syntax_error err -> Printf.eprintf "ERROR: %s\n" err

(** Parses the command-line arguments concerning registers.
    returns [(regs_vals, regs_prints)], where [regs_vals] is the list of pairs
    encoding the initial values of the machine, and [regs_prints] is the list
    of registers that should be printed at the end of execution. *)
let parse_regs (regs : string list) : (int * int) list * int list =
  let rec fail reg =
    Printf.eprintf "ERROR: invalid arguments provided: %s\n" reg;
    usage ();
    exit 1
  and f reg (acc_vals, acc_prints) =
    if String.starts_with ~prefix:"-R" reg then
      let reg' = String.sub reg 2 (String.length reg - 2) in
      match String.split_on_char '=' reg' with
      | [reg_n] ->
        (match int_of_string_opt reg_n with
         | Some reg_n -> (acc_vals, reg_n :: acc_prints)
         | None -> fail reg)
      | [ reg_n ; reg_val ] ->
        (match (int_of_string_opt reg_n, int_of_string_opt reg_val) with
         | (Some reg_n, Some reg_val) ->
           ((reg_n, reg_val) :: acc_vals, acc_prints)
         | _ -> fail reg)
      | _ -> fail reg
    else fail reg
  in List.fold_right f regs ([], [])

(** Parses the [-i] command line argument *)
let parse_iters (iters_str : string) : int =
  match int_of_string_opt iters_str with
  | Some n when n > 0 ->
    n
  | Some n ->
    Printf.eprintf
      "ERROR: negative number of maximum iterations provided: %d\n" n;
    Printf.eprintf "Expected a positive integers\n";
    usage ();
    exit 1
  | None ->
    Printf.eprintf
      "ERROR: invalid number of maximum iterations provided: '%s'\n"
      iters_str;
    Printf.eprintf "Expected a positive integers\n";
    usage ();
    exit 1

(** Parses all command line arguments *)
let (iters, init_m, regs_prints, filepath) : int * Urm.t * int list * string =
  match Array.to_list Sys.argv with
  | _ :: file_path :: "-i" :: iters_str :: regs ->
    let (reg_vals, reg_prints) = parse_regs regs in
    (parse_iters iters_str, Urm.of_list reg_vals, reg_prints, file_path)
  | _ :: file_path :: regs ->
    let (reg_vals, reg_prints) = parse_regs regs in
    (default_max_iters, Urm.of_list reg_vals, reg_prints, file_path)
  | _ ->
    Printf.eprintf "ERROR: not enought arguments provided\n";
    usage ();
    exit 1

(** Try to open the file with the contents of the program *)
let file =
  try
    if Sys.is_directory filepath
    then raise (Sys_error (Printf.sprintf "Is a directory: %s" filepath))
    else open_in filepath
  with Sys_error err ->
    Printf.eprintf "ERROR: %s\n" err;
    exit 1

let () = main iters init_m regs_prints file