Skip to content
This repository
Browse code

[enhance] compiler, printer: Added a class of printer usefull for cyc…

…lic type and use it for typer.cyclic warnings
  • Loading branch information...
commit 4d3328972356bbbe90e811aa88d78ae5401e476d 1 parent e8514a1
Quentin Bourgerie BourgerieQuentin authored
3  libqmlcompil/qmlMakeTyper.ml
@@ -383,9 +383,10 @@ struct
383 383 if QmlAstWalk.Type.exists (function
384 384 | QmlAst.TypeName (_, ident) -> QmlTypes.Env.TypeIdent.mem ident cyclic_gamma
385 385 | _ -> false) ty then
  386 + let printer = new QmlTypes.pp_with_gamma cyclic_gamma in
386 387 QmlError.warning ~wclass:QmlTyperWarnings.cyclic
387 388 context
388   - "Cyclic type %a" QmlPrint.pp#ty ty
  389 + "@[This expression has type %a@ which contains cyclic types:@ %a@]" printer#ty ty printer#flush ()
389 390 )
390 391 else fun _ _ -> ()
391 392 in
30 libqmlcompil/qmlTypes.ml
@@ -888,3 +888,33 @@ let check_no_duplicate_type_defs =
888 888 (List.concat_map
889 889 (function Q.NewType (_, l) ->
890 890 List.map (fun ty_def -> ty_def.QmlAst.ty_def_name) l | _ -> []))
  891 +
  892 +
  893 +class pp_with_gamma gamma =
  894 + let to_flush = ref IdentMap.empty in
  895 + let flushed = ref IdentMap.empty in
  896 +object(self)
  897 + inherit QmlPrint.opa_printer as super
  898 + method typeident f t =
  899 + if Env.TypeIdent.mem t gamma
  900 + && not (IdentMap.mem t !flushed ) then
  901 + to_flush := IdentMap.add t (Env.TypeIdent.find ~visibility_applies:false t gamma) !to_flush;
  902 + super#typeident f t
  903 +
  904 + method flush f () =
  905 + Format.fprintf f "@[<v>";
  906 + let rec aux s =
  907 + if IdentMap.is_empty !to_flush then ()
  908 + else
  909 + let (t, (sch,_)) = IdentMap.min !to_flush in
  910 + to_flush := IdentMap.remove t !to_flush;
  911 + flushed := IdentMap.add t sch !flushed ;
  912 + let ty = Scheme.instantiate sch in
  913 + Format.fprintf f "@[%s %a = %a @]" s self#typeident t self#ty ty;
  914 + if IdentMap.is_empty !to_flush then ()
  915 + else aux "and"
  916 + in aux "type";
  917 + to_flush := IdentMap.empty;
  918 + flushed := IdentMap.empty;
  919 + Format.fprintf f "@]"
  920 +end
11 libqmlcompil/qmlTypes.mli
@@ -441,3 +441,14 @@ val process_typenames_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotm
441 441
442 442 (** fails if there are duplicate type definitions *)
443 443 val check_no_duplicate_type_defs : QmlAst.code -> unit
  444 +
  445 +
  446 +(** A class of printer which collects type identifiers printed in types and
  447 + present on the given [gamma]. Then the flush method prints definitions
  448 + corresponding to the collected identifiers. *)
  449 +class pp_with_gamma :
  450 + gamma -> object
  451 + inherit QmlPrint.opa_printer
  452 + method flush : unit BaseFormat.pprinter
  453 + end
  454 +

0 comments on commit 4d33289

Please sign in to comment.
Something went wrong with that request. Please try again.