Source file Std_ast.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
(**************************************************************************
 *                                                                        *
 *                              OCamlFormat                               *
 *                                                                        *
 *            Copyright (c) Facebook, Inc. and its affiliates.            *
 *                                                                        *
 *      This source code is licensed under the MIT license found in       *
 *      the LICENSE file in the root directory of this source tree.       *
 *                                                                        *
 **************************************************************************)

open Parser_standard
include Parsetree

(* we always want all extensions enabled in ocamlformat *)
let () =
  Language_extension.set_universe_and_enable_all
    Language_extension.Universe.Alpha

type use_file = toplevel_phrase list

type 'a t =
  | Structure : structure t
  | Signature : signature t
  | Use_file : use_file t
  | Core_type : core_type t
  | Module_type : module_type t
  | Expression : expression t
  (* not implemented *)
  | Repl_file : unit t
  | Documentation : unit t

type any_t = Any : 'a t -> any_t [@@unboxed]

let of_syntax = function
  | Syntax.Structure -> Any Structure
  | Signature -> Any Signature
  | Use_file -> Any Use_file
  | Core_type -> Any Core_type
  | Module_type -> Any Module_type
  | Expression -> Any Expression
  | Repl_file -> Any Repl_file
  | Documentation -> Any Documentation

let equal (type a) (_ : a t) : a -> a -> bool = Poly.equal

let map (type a) (x : a t) (m : Ast_mapper.mapper) : a -> a =
  match x with
  | Structure -> m.structure m
  | Signature -> m.signature m
  | Use_file ->
      List.filter_map ~f:(fun x ->
          match m.toplevel_phrase m x with
          | Ptop_def [] -> None
          | Ptop_def _ as x -> Some x
          | Ptop_dir _ as x -> Some x )
  | Core_type -> m.typ m
  | Module_type -> m.module_type m
  | Expression -> m.expr m
  | Repl_file -> Fn.id
  | Documentation -> Fn.id

module Parse = struct
  let ast (type a) (fg : a t) ~input_name str : a =
    let lexbuf = Lexing.from_string str in
    Location.init lexbuf input_name ;
    match fg with
    | Structure -> Parse.implementation lexbuf
    | Signature -> Parse.interface lexbuf
    | Use_file -> Parse.use_file lexbuf
    | Core_type -> Parse.core_type lexbuf
    | Module_type -> Parse.module_type lexbuf
    | Expression -> Parse.expression lexbuf
    | Repl_file -> ()
    | Documentation -> ()
end

module Printast = struct
  include Printast

  let use_file = Format.pp_print_list top_phrase

  let ast (type a) : a t -> _ -> a -> _ = function
    | Structure -> implementation
    | Signature -> interface
    | Use_file -> use_file
    | Core_type -> core_type 0
    | Module_type -> module_type 0
    | Expression -> expression 0
    | Repl_file -> fun _ _ -> ()
    | Documentation -> fun _ _ -> ()
end