src/interpreter.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
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

open Format
open Syntax

let process source_code_file debug env =
  match Env.get_package source_code_file env with
  | Ok vl -> Ok (vl, env)
  | Error _ -> (
    let ic = open_in source_code_file in
    let lexbuf = Sedlexing.Utf8.from_channel ic in
    try
      Sedlexing.set_filename lexbuf source_code_file;
      let lexer = Sedlexing.with_tokenizer Lexer.token lexbuf in
      let parser =
        MenhirLib.Convert.Simplified.traditional2revised Parser.chunk
      in
      let chunk = parser lexer in
      if debug then begin
        print_endline "debug mode: initial source view ...";
        Ast.print_block Format.std_formatter chunk
      end;
      let* () = Static_analysis.Variadic_func.analyze chunk in
      let* () = Static_analysis.Const_var.analyze chunk in
      let chunk, env = Scope.analysis chunk env in
      if debug then begin
        print_endline "debug mode: source after scope analysis view ...";
        Ast.print_block Format.std_formatter chunk
      end;
      let* vl, env = Interpret.run chunk env in
      let env = Env.add_package source_code_file vl env in
      let () = close_in ic in
      Ok (vl, env)
    with
    | Lexer.Lexing_error message ->
      let message = sprintf "Lexical error: %s" message in
      Error (None, message)
    | Parser.Error ->
      let loc = Sedlexing.lexing_positions lexbuf in
      Error (Some loc, "Syntax error")
    | Env.Env_error (_, message) ->
      let message = sprintf "Env error: %s" message in
      Error (None, message)
    | Static_analysis.Static_analysis_error (loc, message) ->
      let message = sprintf "Static analysis error: %s" message in
      Error (loc, message)
    | Typer.Typing_error (loc, message) ->
      let message = sprintf "Typing error: %s" message in
      Error (loc, message)
    | Evaluator.Evaluation_error (loc, message) ->
      let message = sprintf "Evaluation error: %s" message in
      Error (loc, message)
    | Interpret.Interpretation_error (loc, message) ->
      let message = sprintf "Interpretation error: %s" message in
      Error (loc, message) )