Source file `reason_implementation_printer.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
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
98
99
open Reason
open Ppxlib

type t = Parsetree.structure

let err = Printer_maker.err

(* Note: filename should only be used with .ml files. See reason_toolchain. *)
let defaultImplementationParserFor use_stdin filename =
  let open Reason_toolchain in
  let theParser, parsedAsML =
    if Filename.check_suffix filename ".re"
    then RE.implementation_with_comments, false
    else if Filename.check_suffix filename ".ml"
    then ML.implementation_with_comments, true
    else
      err
        ("Cannot determine default implementation parser for filename '"
        ^ filename
        ^ "'.")
  in
  let ast, comments = theParser (setup_lexbuf ~use_stdin filename) in
  { Printer_maker.ast
  ; comments
  ; parsed_as_ml = parsedAsML
  ; parsed_as_intf = false
  }

let parse ~use_stdin filetype filename =
  let { Printer_maker.ast
      ; comments
      ; parsed_as_ml = parsedAsML
      ; parsed_as_intf = parsedAsInterface
      }
    =
    match filetype with
    | `Auto -> defaultImplementationParserFor use_stdin filename
    | `BinaryReason -> Printer_maker.reasonBinaryParser use_stdin filename
    | `Binary -> Printer_maker.ocamlBinaryParser use_stdin filename
    | `ML ->
      let lexbuf = Reason_toolchain.setup_lexbuf ~use_stdin filename in
      let impl = Reason_toolchain.ML.implementation_with_comments in
      let ast, comments = impl lexbuf in
      { ast; comments; parsed_as_ml = true; parsed_as_intf = false }
    | `Reason ->
      let lexbuf = Reason_toolchain.setup_lexbuf ~use_stdin filename in
      let impl = Reason_toolchain.RE.implementation_with_comments in
      let ast, comments = impl lexbuf in
      { ast; comments; parsed_as_ml = false; parsed_as_intf = false }
  in
  if parsedAsInterface
  then err "The file parsed does not appear to be an implementation file."
  else (ast, comments), parsedAsML

let print printtype filename parsedAsML output_chan output_formatter =
  match printtype with
  | `BinaryReason ->
    fun (ast, comments) ->
      (* Our special format for interchange between reason should keep the
       * comments separate.  This is not compatible for input into the
       * ocaml compiler - only for input into another version of Reason. We
       * also store whether or not the binary was originally *parsed* as an
       * interface file.
       *)
      output_value
        output_chan
        ( Ocaml_common.Config.ast_impl_magic_number
        , filename
        , ast
        , comments
        , parsedAsML
        , false )
  | `Binary ->
    fun (ast, _) ->
      let ast =
        ast
        |> Reason_syntax_util.(
             apply_mapper_to_structure remove_stylistic_attrs_mapper)
        |> Reason_syntax_util.(apply_mapper_to_structure backport_letopt_mapper)
      in
      Ppxlib__.Utils.Ast_io.write
        output_chan
        { Ppxlib__.Utils.Ast_io.input_name = filename
        ; input_version =
            Obj.magic
              (module Ppxlib_ast.Compiler_version : Ppxlib_ast.OCaml_version)
        ; ast = Impl ast
        }
        ~add_ppx_context:false
  | `AST ->
    fun (ast, _) ->
      Ocaml_common.Printast.implementation
        output_formatter
        (Reason_toolchain.To_current.copy_structure ast)
  | `None -> fun _ -> ()
  | `ML ->
    Reason_toolchain.ML.print_implementation_with_comments output_formatter
  | `Reason ->
    Reason_toolchain.RE.print_implementation_with_comments output_formatter