Compleating assignment for interpreter, modified grammars, fixed tests

bin/miniFunInterpreter.ml

@@ -0,0 +1,100 @@
+open MiniFun
+open Lexing
+
+(* -------------------------------------------------------------------------- *)
+(*                             Command Arguments                              *)
+
+let () =
+  Clap.description "Interpreter for MiniFun language.";
+
+  let files = Clap.section ~description: "Files to consider." "FILES" in
+  let values = Clap.section ~description: "Input values." "VALUES" in
+
+  let input = Clap.mandatory_string
+      ~description: "Input file."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "input"
+      ~short: 'i'
+      ()
+  in
+
+  let inputval = Clap.optional_int
+      ~description: "Optional input value to feed to the program. \
+                     If not specified it is read from stdin."
+      ~placeholder: "INT"
+      ~section: values
+      ~long: "value"
+      ~short: 'v'
+      ()
+  in
+
+  let output = Clap.optional_string
+      ~description: "Output file. If not specified output is printed on stdout."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "output"
+      ~long_synonyms: ["out"; "result"]
+      ~short: 'o'
+      ()
+  in
+
+  Clap.close ();
+
+(* -------------------------------------------------------------------------- *)
+(*                                Interpreter                                 *)
+
+  let print_position outx lexbuf =
+    let pos = lexbuf.lex_curr_p in
+    Printf.fprintf outx "Encountered \"%s\" at %s:%d:%d"
+      (Lexing.lexeme lexbuf) pos.pos_fname
+      pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
+  in
+
+  let interpret_file inch (inval: int) outch =
+    let lexbuf = Lexing.from_channel inch in
+    let program =
+      try Parser.prg Lexer.read lexbuf with
+      | Lexer.LexingError msg ->
+        Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
+        exit (-1)
+      | Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
+        exit (-1)
+    in
+    let _ =
+      match TypeChecker.typecheck program with
+      | Ok _ -> ()
+      | Error (`AbsentAssignment msg)
+      | Error (`WrongTypeSpecification msg)
+      | Error (`WrongType msg) ->
+        Printf.fprintf stderr "%s\n" msg;
+        exit (-1)
+    in
+    let return_value =
+      match Semantics.reduce program inval with
+        Ok o -> o
+      | Error (`AbsentAssignment msg)
+      | Error (`DivisionByZero msg)
+      | Error (`WrongType msg) ->
+        Printf.fprintf stderr "%s\n" msg;
+        exit (-1)
+    in
+
+    Printf.fprintf outch "%d\n" return_value
+  in
+
+
+  let inx = In_channel.open_text input in
+  let outx = match output with
+      None -> stdout
+    | Some f -> Out_channel.open_text f
+  in
+
+  let inputval = match inputval with
+      None -> (
+        Printf.fprintf stdout "Provide the input: ";
+        read_int ()
+      )
+    | Some o -> o
+  in
+  interpret_file inx inputval outx;