rescript/compiler/gentype/TranslateSignature.ml at 20aa81d28e543e2d9d8c3589d13807559c190082 · rescript-lang/rescript · GitHub

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
open GenTypeCommon

let translate_signature_value ~config ~output_file_relative ~resolver ~type_env
    (value_description : Typedtree.value_description) : Translation.t =
  let {Typedtree.val_attributes; val_desc; val_id; val_loc} =
    value_description
  in
  if !Debug.translation then
    Log_.item "Translate Signature Value %s\n" (val_id |> Ident.name);
  let type_expr = val_desc.ctyp_type in
  let add_annotations_to_function type_ = type_ in
  match
    (val_id, val_attributes |> Annotation.from_attributes ~config ~loc:val_loc)
  with
  | id, GenType ->
    id |> Ident.name |> Ext_ident.unwrap_uppercase_exotic
    |> Translation.translate_value ~attributes:val_attributes ~config
         ~doc_string:(Annotation.doc_string_from_attrs val_attributes)
         ~output_file_relative ~resolver ~type_env ~type_expr
         ~add_annotations_to_function
  | _ -> Translation.empty

let rec translate_module_declaration ~config ~output_file_relative ~resolver
    ~type_env ({md_id; md_type} : Typedtree.module_declaration) =
  let name = md_id |> Ident.name in
  if !Debug.translation then Log_.item "Translate Module Declaration %s\n" name;
  let type_env = type_env |> TypeEnv.new_module ~name in
  match md_type.mty_desc with
  | Tmty_signature signature ->
    signature
    |> translate_signature ~config ~output_file_relative ~resolver ~type_env
    |> Translation.combine
  | Tmty_ident (path, _) -> (
    match type_env |> TypeEnv.lookup_module_type_signature ~path with
    | None -> Translation.empty
    | Some (signature, _) ->
      signature
      |> translate_signature ~config ~output_file_relative ~resolver ~type_env
      |> Translation.combine)
  | Tmty_functor _ ->
    log_not_implemented ("Tmty_functor " ^ __LOC__);
    Translation.empty
  | Tmty_with _ ->
    log_not_implemented ("Tmty_with " ^ __LOC__);
    Translation.empty
  | Tmty_typeof _ ->
    log_not_implemented ("Tmty_typeof " ^ __LOC__);
    Translation.empty
  | Tmty_alias _ ->
    log_not_implemented ("Tmty_alias " ^ __LOC__);
    Translation.empty

and translate_module_type_declaration ~config ~output_file_relative ~resolver
    ~type_env (module_type_declaration : Typedtree.module_type_declaration) =
  if !Debug.translation then
    Log_.item "Translate Module Type Declaration %s\n"
      (module_type_declaration.mtd_id |> Ident.name);
  match module_type_declaration with
  | {mtd_type = None} -> Translation.empty
  | {mtd_id; mtd_type = Some mtd_type} -> (
    match mtd_type.mty_desc with
    | Tmty_signature signature ->
      let name = mtd_id |> Ident.name in
      (* Only translate types *)
      let signature_without_values =
        {
          signature with
          sig_items =
            Ext_list.filter signature.sig_items (function
              | {sig_desc = Tsig_value _} -> false
              | _ -> true);
        }
      in
      let translation =
        signature_without_values
        |> translate_signature ~config ~output_file_relative ~resolver
             ~type_env:(type_env |> TypeEnv.new_module_type ~name ~signature)
        |> Translation.combine
      in
      translation
    | Tmty_ident _ ->
      log_not_implemented ("Tmty_ident " ^ __LOC__);
      Translation.empty
    | Tmty_functor _ ->
      log_not_implemented ("Tmty_functor " ^ __LOC__);
      Translation.empty
    | Tmty_with _ ->
      log_not_implemented ("Tmty_with " ^ __LOC__);
      Translation.empty
    | Tmty_typeof _ ->
      log_not_implemented ("Tmty_typeof " ^ __LOC__);
      Translation.empty
    | Tmty_alias _ ->
      log_not_implemented ("Tmty_alias " ^ __LOC__);
      Translation.empty)

and translate_signature_item ~config ~output_file_relative ~resolver ~type_env
    signature_item : Translation.t =
  match signature_item with
  | {Typedtree.sig_desc = Typedtree.Tsig_type (rec_flag, type_declarations)} ->
    {
      import_types = [];
      code_items = [];
      type_declarations =
        type_declarations
        |> TranslateTypeDeclarations.translate_type_declarations ~config
             ~output_file_relative ~recursive:(rec_flag = Recursive) ~resolver
             ~type_env;
    }
  | {Typedtree.sig_desc = Tsig_value value_description} ->
    let is_import =
      value_description.val_attributes
      |> Annotation.has_attribute Annotation.tag_is_gentype_import
    in
    if value_description.val_prim <> [] || is_import then
      value_description
      |> Translation.translate_primitive ~config ~output_file_relative ~resolver
           ~type_env
    else
      let module_item =
        Runtime.new_module_item ~name:(value_description.val_id |> Ident.name)
      in
      type_env |> TypeEnv.update_module_item ~module_item;
      value_description
      |> translate_signature_value ~config ~output_file_relative ~resolver
           ~type_env
  | {Typedtree.sig_desc = Typedtree.Tsig_module module_declaration} ->
    module_declaration
    |> translate_module_declaration ~config ~output_file_relative ~resolver
         ~type_env
  | {Typedtree.sig_desc = Typedtree.Tsig_modtype module_type_declaration} ->
    let module_item =
      Runtime.new_module_item
        ~name:(module_type_declaration.mtd_id |> Ident.name)
    in
    let config =
      module_type_declaration.mtd_attributes
      |> Annotation.update_config_for_module ~config
    in
    type_env |> TypeEnv.update_module_item ~module_item;
    module_type_declaration
    |> translate_module_type_declaration ~config ~output_file_relative ~resolver
         ~type_env
  | {Typedtree.sig_desc = Typedtree.Tsig_typext _} ->
    log_not_implemented ("Tsig_typext " ^ __LOC__);
    Translation.empty
  | {Typedtree.sig_desc = Typedtree.Tsig_exception _} ->
    log_not_implemented ("Tsig_exception " ^ __LOC__);
    Translation.empty
  | {Typedtree.sig_desc = Typedtree.Tsig_recmodule _} ->
    log_not_implemented ("Tsig_recmodule " ^ __LOC__);
    Translation.empty
  | {Typedtree.sig_desc = Typedtree.Tsig_open _} ->
    log_not_implemented ("Tsig_open " ^ __LOC__);
    Translation.empty
  | {Typedtree.sig_desc = Typedtree.Tsig_include _} ->
    log_not_implemented ("Tsig_include " ^ __LOC__);
    Translation.empty
  | {Typedtree.sig_desc = Typedtree.Tsig_attribute _} ->
    log_not_implemented ("Tsig_attribute " ^ __LOC__);
    Translation.empty

and translate_signature ~config ~output_file_relative ~resolver ~type_env
    signature : Translation.t list =
  if !Debug.translation then Log_.item "Translate Signature\n";
  signature.Typedtree.sig_items
  |> List.map
       (translate_signature_item ~config ~output_file_relative ~resolver
          ~type_env)