Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 687 lines (598 sloc) 20.445 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
4 This file is part of Opa.
fccc685 Initial open-source release
MLstate authored
5
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
6 Opa is free software: you can redistribute it and/or modify it under the
fccc685 Initial open-source release
MLstate authored
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc685 Initial open-source release
MLstate authored
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc685 Initial open-source release
MLstate authored
17 *)
18 (* depends in base *)
19 module Char = BaseChar
20 module Format = BaseFormat
21 module List = BaseList
22 module String = BaseString
23
24 let (|>) = InfixOperator.(|>)
25
26 (* refactoring in progress *)
27
28 (* shorthands *)
29 module E = OpaEnv
30 module P = Passes
31 module SA = SurfaceAst
32 module Q = QmlAst
33
34 (* type alias for clarty *)
35 type filename = string
36 type pos = int
37 type path = string list
38
39 type short_coll = path * Annot.label
40 type collection = path * filename * pos * QmlAst.ty
41
42
43 (*
44 traversed directive for finding fields of a module from a toplevel value
45 to add doc type api directives
46 *)
47 type ('a, 'b, 'c) traversed_directive = [
48 | `coerce
49 | `deprecated
50 | `local of 'a
51 | Q.slicer_directive
52 ]
53
54 (**
55 Merge access directive
56 *)
57 let merge_access (acc : SurfaceAst.access_directive) ( dir : SurfaceAst.access_directive ) : SurfaceAst.access_directive =
58 match acc, dir with
59 | `private_, _ -> acc
60 | _, `private_ -> dir
61 | `package, _ -> acc
62 | _, `package -> dir
63 | _ -> acc
64
65 (**
66 extract annotation type of top-level values and type of their eventual fields
67 (if the final expression of the top level value is a record)
68 *)
69 let add_code_doctype sa_code =
70 let keep_local modify e =
71 match fst e with
72 | SA.Directive(`local _ as l,[e],c) -> SA.Directive(l, [modify e], c), snd e
73 | _ -> assert false
74 in
75 let final_expr_sub_1 main_e sube =
76 let main_e, annot = main_e in
77 (match main_e with
78 | SA.Lambda(z,_) -> SA.Lambda(z,sube)
79 | SA.Directive(z0,[_],z2) -> SA.Directive(z0,[sube],z2)
80 | SA.LetIn(b, z, _) -> SA.LetIn(b, z, sube)
81 | _ -> assert false
82 ), annot
83 in
84 (**
85 add doctype directives to sub modules fields,
86 and returns the accessibility of the toplevel expression
87 *)
88 let rec add_e_doctype access path e : SA.access_directive * (_, _) SA.expr =
89 match fst e with
90
91 (* access *)
92 | SA.Directive ((#SA.access_directive as sub_access), [ sube ], _) ->
93 let access = merge_access access sub_access in
94 let access, sube = add_e_doctype access path sube in
95 access, final_expr_sub_1 e sube
96
97 (* go through for finding fields of modules *)
98 | SA.Lambda(_, sube)
99 | SA.Directive (#traversed_directive, [ sube ], _)
100 ->
101 let access, sube = add_e_doctype access path sube in
102 access, final_expr_sub_1 e sube
103
104 (* collect here and recurse *)
105 | SA.LetIn(x, l, sube) ->
106 let access, sube = add_e_doctype access path sube in
107 access, (SA.LetIn(x, l, sube), (snd e))
108
109 | SA.Directive(`module_ , [SA.Record( fields ), annot],ty)
110 when SurfaceAstHelper.Record.is_module e ->
111 (* since module header can be rewritten , we collect the annot here *)
112 let new_record = SA.Record (
113 List.map (
114 fun (f,e) ->
115 let npath = path @ [f] in
116 #<If:OPADOC> OManager.printf "Adding %s@." (String.concat "." npath) #<End>;
117 let modify e =
118 let access, sube = add_e_doctype access npath e in
119 keep_local
120 (SurfaceAstCons.ExprIdentCons.D.doctype ~label:(snd e) ~access npath)
121 sube
122 in
123 (f, modify e)
124 ) fields )
125 in
126 access, (SA.Directive(`module_, [new_record, annot], ty), snd e)
127
128 (* ignore *)
129 | _ -> access, e
130 in
131 let rec add_patt_doctype ((name,e) as decl) =
132 let rec getname name =
133 match fst name with
134 | SA.PatCoerce (n,_) -> getname n
135 | SA.PatVar n
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
136 | SA.PatAs (_,n) -> Some n.SA.ident
fccc685 Initial open-source release
MLstate authored
137 | _ -> None
138 in
139 match getname name with
140 |Some n ->
141 let path = [Ident.original_name n] in
142 #<If:OPADOC> OManager.printf "Fold %s@." (Ident.original_name n) #<End>;
143 let access, sube = add_e_doctype `public path e in
144 name, (SurfaceAstCons.ExprIdentCons.D.doctype ~label:(snd e) ~access path) sube
145 | _ -> decl
146 in
147 List.tail_map
148 (function
149 | SA.NewVal (l, b), annot ->
150 SA.NewVal (List.map add_patt_doctype l, b), annot
151 | t -> t) sa_code
152
153 let collect_type_doctype sa_code =
154 List.rev (List.fold_left (fun acc -> function (SA.NewType tds, _) -> tds @ acc | _ -> acc) [] sa_code)
155
156
157 (**
158 output top-level value type description for opa-doc
159 *)
160 let process_opa ~(options : E.opa_options) env =
161 if options.E.generate_interface || options.E.generate_interface_and_compile then
162 { env with Passes.
163 sa_lcode = add_code_doctype env.P.sa_lcode ;
164 sa_doc_types = collect_type_doctype env.P.sa_lcode }
165 else env
166
167
168 (* =========================================================== *)
169 (* SECOND PART; OpaDocApiGeneration *)
170 (* =========================================================== *)
171
172
173 (**
174 This function filter the code, by removing [`doctype] diretives
175 introduced by the first part (pass_AddDocApiDirecitves).
176
177 It returns the filtered annotmap, and collect all the decorated path,
178 in the form of an assoc list, binding pathes of decorated elements
179 with there label (so that we can find their types and position)
180 *)
181 let remove_code_doctype annotmap (qmlAst : QmlAst.code) :
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
182 (QmlAst.annotmap * (string list * QmlAst.expr * QmlAst.doctype_access_directive) list) * QmlAst.code
fccc685 Initial open-source release
MLstate authored
183 =
184 let rec remove_expr_doctype (annotmap, acc) e =
185 match e with
186 | Q.Directive (label, `doctype (path, access), [sube], []) ->
187 let annot_e = Annot.annot label in
188 let tsc_opt =
189 QmlAnnotMap.find_tsc_opt annot_e annotmap in
190 let tsc_inst_opt =
191 QmlAnnotMap.find_tsc_inst_opt annot_e annotmap in
192 let annotmap =
193 QmlAnnotMap.remove_tsc annot_e annotmap in
194 let annotmap =
195 QmlAnnotMap.remove_tsc_inst annot_e annotmap in
196 let sube_tsc_opt =
197 QmlAnnotMap.find_tsc_opt annot_e annotmap in
198 let sube_tsc_inst_opt =
199 QmlAnnotMap.find_tsc_inst_opt annot_e annotmap in
200 let tsc_opt =
201 Option.merge (fun _ _ -> assert false) tsc_opt sube_tsc_opt in
202 let tsc_inst_opt =
203 Option.merge
204 (fun _ _ -> assert false) tsc_inst_opt sube_tsc_inst_opt in
205 let annot_sube = QmlAst.QAnnot.expr sube in
206 let annotmap =
207 QmlAnnotMap.add_tsc_opt annot_sube tsc_opt annotmap in
208 let annotmap =
209 QmlAnnotMap.add_tsc_inst_opt annot_sube tsc_inst_opt annotmap in
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
210 ((annotmap, (path, sube, access) :: acc), sube)
fccc685 Initial open-source release
MLstate authored
211 | _ -> ((annotmap, acc), e) in
212 let remove_patt_doctype acc e =
213 QmlAstWalk.Expr.foldmap_down remove_expr_doctype acc e
214 in
215 QmlAstWalk.CodeExpr.fold_map remove_patt_doctype (annotmap, []) qmlAst
216
217
218 module Api =
219 struct
220
221 (**
222 This module defines the ocaml structures corresponding to the opa structures
223 defined in [opaDocTy.opa].
224
225 This is not a code duplication, but an easyer way to ensure than this pass
226 generates serialized values corresponding to the value defined in opa.
227
228 The documentation of these types is in the opa code.
229 *)
230
231 type ty = QmlAst.ty
232
233 type pkg = string
234
235 type path = string list
236
237 (**
238 <!> The fields are there prefixed by ["value_"] but not in opa
239 *)
240 type value = {
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
241 value_args : string list;
fccc685 Initial open-source release
MLstate authored
242 value_ty : ty ;
243 value_visibility : QmlAst.doctype_access_directive ;
244 }
245
246 (**
247 <!> In opa, the fields contained in the type defs are flattened.
248 We keep it like this to possibly export for opadoc more infos
249 than infos contained in the QmlAst.typedef
250 *)
251 type type_def = {
252 type_def : QmlAst.typedef
253 }
254
255 type code_elt =
256 | Value of value
257 | Type of type_def
258
259 type file = string
260 type pos = int
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
261 type line = int
fccc685 Initial open-source release
MLstate authored
262
263 type entry = {
264 pkg : pkg ;
265 path : path ;
266 code_elt : code_elt ;
267 fname : file ;
268 pos : pos ;
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
269 line : line ;
fccc685 Initial open-source release
MLstate authored
270 }
271
272 module Entry :
273 sig
274
275 (**
276 Build a value type from collected informations
277 *)
278
279 (**
280 Values
281 *)
282 val value :
283 gamma:QmlTypes.gamma ->
284 annotmap:QmlAst.annotmap ->
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
285 (string list * QmlAst.expr * QmlAst.doctype_access_directive -> entry)
fccc685 Initial open-source release
MLstate authored
286
287 (**
288 Types definitions
289 *)
290 val type_def :
291 gamma:QmlTypes.gamma ->
292 annotmap:QmlAst.annotmap ->
293 (Ident.t SA.typedef -> entry)
294
295 (**
296 Pretty printing api-txt (for debuging)
297 *)
298 val pp : Format.formatter -> entry -> unit
299 end =
300 struct
301
302 let make_entry () =
303 let pkg = ObjectFiles.get_current_package_name () in
304 let make ~path ~filepos ~code_elt =
305 let fname = FilePos.get_file filepos in
306 let pos = FilePos.get_first_char filepos in
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
307 let line = try snd(FilePos.get_line fname pos) with _ -> (-1) in
fccc685 Initial open-source release
MLstate authored
308 let entry = {
309 pkg ;
310 path ;
311 code_elt ;
312 fname ;
313 pos ;
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
314 line ;
fccc685 Initial open-source release
MLstate authored
315 } in
316 entry
317 in
318 make
319
320 let value ~gamma:_ ~annotmap =
321 let make_entry = make_entry () in
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
322 let value (path, expr, visibility) =
323 let label = QmlAst.Label.expr expr in
fccc685 Initial open-source release
MLstate authored
324 let filepos = Annot.pos label in
325 let annot = Annot.annot label in
326 let ty = QmlAnnotMap.find_ty annot annotmap in
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
327 let args =
328 match ty with
329 | Q.TypeArrow(_, _) ->
330 begin match expr with
331 | Q.Lambda(_, args, _) ->
332 List.map Ident.original_name args
333 | _ -> []
334 end
335 | _ -> []
336 in
fccc685 Initial open-source release
MLstate authored
337 let code_elt = Value {
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
338 value_args = args ;
fccc685 Initial open-source release
MLstate authored
339 value_ty = ty ;
340 value_visibility = visibility ;
341 } in
342 make_entry ~path ~filepos ~code_elt
343 in
344 value
345
346 let type_def ~gamma:_ ~annotmap:_ =
347 let make_entry = make_entry () in
348 let type_ typedef =
349 let typedef, loc = typedef in
350 let filepos = loc.QmlLoc.pos in
351 let SA.Typeident ident = typedef.SA.ty_def_name in
352 let ident = Ident.original_name ident in
353 let path = [ ident ] in
354 let typedef = OpaToQml.UidsOpaToQml.typedef typedef in
355 let code_elt = Type {
356 type_def = typedef ;
357 } in
358 make_entry ~path ~filepos ~code_elt
359 in
360 type_
361
362 let pp_path_elt fmt elt =
363 let elt =
364 if String.length elt > 0 && Char.is_alpha elt.[0] && String.is_word elt
365 then elt
366 else "`" ^ elt ^ "`"
367 in
368 Format.pp_print_string fmt elt
369
370 let pp_light_ident = new QmlPrint.light_ident_printer
371
372 let pp_value_visibility fmt = function
373 | `public -> ()
374 | `private_ -> Format.pp_print_string fmt "@private "
375 | `package -> Format.pp_print_string fmt "@package "
376
377 let pp_value fmt path value =
378 let visibility = value.value_visibility in
379 let ty = value.value_ty in
380 Format.fprintf fmt
381 "%a%a : %a@\n@\n"
382 pp_value_visibility visibility
383 (Format.pp_list "." pp_path_elt) path
384 pp_light_ident#ty_new_scope ty
385
386 let pp_type fmt type_def =
387 pp_light_ident#reset_typevars ;
388 let typedef = type_def.type_def in
389 Format.fprintf fmt
390 "%a@\n@\n"
391 pp_light_ident#typedef typedef
392
393 let pp fmt entry =
394 match entry.code_elt with
395 | Value value -> pp_value fmt entry.path value
396 | Type type_def -> pp_type fmt type_def
397 end
398 end
399
400
401 (**
402 Json serialization, from Api structure (module above) to Json structures
403 ready to be loaded by opa.
404 *)
405 module Serialize :
406 sig
407 val entry :
408 gamma:QmlTypes.gamma ->
409 annotmap:QmlAst.annotmap ->
410 (Api.entry -> JsonTypes.json)
411 end =
412 struct
413 module J = JsonTypes
414
415 let string s = J.String s
416 let pkg pkg = J.String pkg
417 let file file = J.String file
418 let pos pos = J.Int pos
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
419 let line line = J.Int line
fccc685 Initial open-source release
MLstate authored
420 let path path = J.Array (List.map string path)
421
422 (**
423 Given a Qml Expression representing an OpaTy.ty (runtime type ast),
424 returns its serialized version (json)
425 *)
426 let rec opaty_to_json expr =
427 match expr with
428 | Q.Coerce (_, expr, _ty) -> opaty_to_json expr
429 | Q.Const (_, (Q.String s)) -> string s
430 | Q.Directive (_, `tagged_string (tyname, _kind), [], []) -> string tyname
431 | Q.Record (_, fields) ->
432 let fold acc (field, expr) =
433 (field, opaty_to_json expr) :: acc
434 in
435 let fields = List.sort (fun (s1, _) (s2, _) -> String.compare s2 s1) fields in
436 J.Record (List.fold_left fold [] (List.rev fields))
437 | _ -> OManager.i_error "Unexpected expr in opaty_to_json: %a@." QmlPrint.pp#expr expr
438
439
440 class serializer ~gamma ~annotmap =
441 let ty_to_opaty_for_opadoc =
442 Pass_ExplicitInstantiation.ty_to_opaty_for_opadoc
443 ~val_:OpaMapToIdent.val_
444 ~gamma
445 ~annotmap
446 in
447 object(self)
448
449 val gamma = gamma
450 val annotmap = annotmap
451
452 (** Variables scope for type variables *)
453 val typevar_scope = QmlTypeVars.TypeVarPrint.new_scope ()
454 val rowvar_scope = QmlTypeVars.RowVarPrint.new_scope ()
455 val colvar_scope = QmlTypeVars.ColVarPrint.new_scope ()
456
457 method reset_typevars =
458 QmlTypeVars.TypeVarPrint.reset typevar_scope ;
459 QmlTypeVars.RowVarPrint.reset rowvar_scope ;
460 QmlTypeVars.ColVarPrint.reset colvar_scope ;
461 ()
462
463 method typevar var = QmlTypeVars.TypeVarPrint.get typevar_scope var
464 method rowvar var = QmlTypeVars.RowVarPrint.get rowvar_scope var
465 method colvar var = QmlTypeVars.ColVarPrint.get colvar_scope var
466
467 (**
468 Given a Qml Types, and typer environment, transform it into a runtime type expression.
469
470 This use a normalization specialized for the documentation, preserving original names when
471 there are some provided, and generated pretty names ('a, 'b, 'c, etc.) when there
472 is no name provided.
473 This is a normalization at compile time.
474 *)
475 method ty ty =
476 let ty = ty_to_opaty_for_opadoc typevar_scope rowvar_scope colvar_scope ty in
477 opaty_to_json ty
478
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
479 method args args = J.Array (List.map string args)
480
fccc685 Initial open-source release
MLstate authored
481 method visibility (vis : QmlAst.doctype_access_directive) =
482 (*
483 <!> keep synchronized with opa names, cf OpaDocTy
484 *)
485 let field =
486 match vis with
487 | `private_ -> "private"
488 | `public -> "public"
489 | `package -> "package_"
490 in
491 J.Record [
492 field, J.Void ;
493 ]
494
495 method value v =
496 (*
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
497 <!> Opa magic serialize, reverse of alphabetic order between fields
fccc685 Initial open-source release
MLstate authored
498 *)
499 J.Record [
500 "visibility", self#visibility v.Api.value_visibility ;
501 "ty", self#ty v.Api.value_ty ;
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
502 "args", self#args v.Api.value_args ;
fccc685 Initial open-source release
MLstate authored
503 ]
504
505 (*
506 FIXME:
507 currently, the representation of type def is a tuple Api.ty * Api.ty
508 in opadoc, which is not extensible enough to cover directives, and visibility.
509 This will change for a record containing visibility informations.
510 *)
511 method type_def type_def =
512 let type_def = type_def.Api.type_def in
513 let name =
514 string
515 (Q.TypeIdent.to_string type_def.QmlAst.ty_def_name)
516 in
517 let params =
518 let param tyvar = string (self#typevar tyvar) in
519 let params = List.map param type_def.QmlAst.ty_def_params in
520 JsonTypes.Array params
521 in
522 let visibility =
523 match type_def.QmlAst.ty_def_visibility with
524 | Q.TDV_public ->
525 J.Record [
526 "TDV_public", J.Void ;
527 ]
528 | Q.TDV_abstract package_name ->
529 J.Record [
530 "TDV_abstract", string package_name ;
531 ]
532 | Q.TDV_private package_name ->
533 J.Record [
534 "TDV_private", string package_name ;
535 ]
536 in
537 let body = self#ty type_def.QmlAst.ty_def_body in
538 (*
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
539 <!> Opa magic serialize, reverse of alphabetic order between fields
fccc685 Initial open-source release
MLstate authored
540 *)
541 let tuple = JsonTypes.Record [
542 "ty_def_visibility", visibility ;
543 "ty_def_params", params ;
544 "ty_def_name", name ;
545 "ty_def_body", body ;
546 ] in
547 tuple
548
549 method code_elt api =
550 match api with
551 | Api.Value value ->
552 J.Record [
553 "value", self#value value ;
554 ]
555
556 | Api.Type type_def ->
557 J.Record [
558 "type_def", self#type_def type_def ;
559 ]
560
561 method entry e =
562 (*
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
563 <!> Opa magic serialize, reverse of alphabetic order between fields
fccc685 Initial open-source release
MLstate authored
564 *)
565 J.Record [
566 "pos", pos e.Api.pos ;
567 "pkg", pkg e.Api.pkg ;
568 "path", path e.Api.path ;
069836f @Aqua-Ye [enhance] api: improved api doc by adding line info to api entry
Aqua-Ye authored
569 "line", line e.Api.line ;
fccc685 Initial open-source release
MLstate authored
570 "fname", file e.Api.fname ;
571 "code_elt", self#code_elt e.Api.code_elt ;
572 ]
573 end
574
575 let entry ~gamma ~annotmap =
576 let serializer = new serializer ~gamma ~annotmap in
577 let map entry =
578 (*
579 The scope of type variables is reset between each new entry
580 *)
581 serializer#reset_typevars ;
582 serializer#entry entry
583 in
584 map
585
586 end
587
588 (**
589 Print an error if a filename cannot be created
590 *)
591 let on_error filename error =
592 match error with
593 | None -> ()
594 | Some msg ->
595 OManager.error (
596 "cannot output file %S@\n"^^
597 "@[<2>@{<bright>Hint@}:@\n"^^
598 "%s@]"
599 ) filename msg
600
601 (**
602 FileMap:
603 A polymorphic map for storing a list of 'a associated to a filename
604 *)
605 module FileMap = ListMap.Make(Order.String)
606
607 (**
608 Process the qml code, meaning remove the previously inserted doctypes directives,
609 and generate api files (opadoc), as well as humain readable api-txt files (for debug)
610 *)
611 let process_qml ~(options : E.opa_options)
612 (env : 'tmp_env Passes.env_Gen) : 'tmp_env Passes.env_Gen =
613 let annotmap = env.P.typerEnv.QmlTypes.annotmap in
614 let gamma = env.P.typerEnv.QmlTypes.gamma in
615
616 let make_value = Api.Entry.value ~gamma ~annotmap in
617 let make_type_def = Api.Entry.type_def ~gamma ~annotmap in
618
619 (*
620 Remove `doctype directives, filter annotmap, and collect doc values
621 *)
622 let ((annotmap, coll), qmlAst) = remove_code_doctype annotmap env.P.qmlAst in
623
624 (* OUTPUTS *)
625 if options.E.generate_interface || options.E.generate_interface_and_compile then (
626
627 (*
628 Construct the map filenames --> data
629 *)
630 let byfile = FileMap.empty in
631
632 (*
633 1. add Value data, collected by [remove_code_doctype]
634 *)
635 let byfile =
636 List.fold_left
2384a5f @Aqua-Ye [enhance] api: improved api info by giving the complete QmlAst.expr i…
Aqua-Ye authored
637 (fun byfile ((_, expr, _) as value) ->
638 let label = QmlAst.Label.expr expr in
fccc685 Initial open-source release
MLstate authored
639 let filename = FilePos.get_file (Annot.pos label) in
640 let entry = make_value value in
641 FileMap.append filename entry byfile)
642 byfile coll
643 in
644
645 (*
646 2. add Type data, from doc_types stored in the environment
647 *)
648 let byfile =
649 List.fold_left
650 (fun byfile ((_, a) as typedef) ->
651 let filename = FilePos.get_file a.QmlLoc.pos in
652 let entry = make_type_def typedef in
653 FileMap.append filename entry byfile)
654 byfile (List.rev env.P.doc_types)
655 in
656
657 (* JSON OUTPUT *)
658 let entry_to_json = Serialize.entry ~gamma ~annotmap in
659 FileMap.iter (fun file entries ->
660 let filename = file ^ ".api" in
661 let jsonl = JsonTypes.Array (List.tail_map entry_to_json entries) in
662 OManager.verbose "generating %S" filename ;
663 let error = File.oc_output filename JsonPrint.Output.json jsonl in
664 on_error filename error ;
665 ) byfile ;
666
667 (* HUMAN OUTPUT *)
668 FileMap.iter (fun file entries ->
669 let filename = file ^ ".api-txt" in
670 OManager.verbose "generating %S" filename ;
671 let error = File.pp_output filename (Format.pp_list "" Api.Entry.pp) entries in
672 on_error filename error ;
673 ) byfile ;
674
675 (* EXITING PASS *)
676 if not options.E.generate_interface_and_compile then
677 exit 0
678
679 );
680
681 { env with Passes.
682 qmlAst = qmlAst;
683 typerEnv = { env.P.typerEnv with
684 QmlTypes.annotmap = annotmap;
685 };
686 }
Something went wrong with that request. Please try again.