Skip to content
Browse files

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

…lic type and use it for typer.cyclic warnings
  • Loading branch information...
1 parent e8514a1 commit 4d3328972356bbbe90e811aa88d78ae5401e476d @BourgerieQuentin BourgerieQuentin committed Feb 23, 2012
Showing with 43 additions and 1 deletion.
  1. +2 −1 libqmlcompil/qmlMakeTyper.ml
  2. +30 −0 libqmlcompil/qmlTypes.ml
  3. +11 −0 libqmlcompil/qmlTypes.mli
View
3 libqmlcompil/qmlMakeTyper.ml
@@ -383,9 +383,10 @@ struct
if QmlAstWalk.Type.exists (function
| QmlAst.TypeName (_, ident) -> QmlTypes.Env.TypeIdent.mem ident cyclic_gamma
| _ -> false) ty then
+ let printer = new QmlTypes.pp_with_gamma cyclic_gamma in
QmlError.warning ~wclass:QmlTyperWarnings.cyclic
context
- "Cyclic type %a" QmlPrint.pp#ty ty
+ "@[This expression has type %a@ which contains cyclic types:@ %a@]" printer#ty ty printer#flush ()
)
else fun _ _ -> ()
in
View
30 libqmlcompil/qmlTypes.ml
@@ -888,3 +888,33 @@ let check_no_duplicate_type_defs =
(List.concat_map
(function Q.NewType (_, l) ->
List.map (fun ty_def -> ty_def.QmlAst.ty_def_name) l | _ -> []))
+
+
+class pp_with_gamma gamma =
+ let to_flush = ref IdentMap.empty in
+ let flushed = ref IdentMap.empty in
+object(self)
+ inherit QmlPrint.opa_printer as super
+ method typeident f t =
+ if Env.TypeIdent.mem t gamma
+ && not (IdentMap.mem t !flushed ) then
+ to_flush := IdentMap.add t (Env.TypeIdent.find ~visibility_applies:false t gamma) !to_flush;
+ super#typeident f t
+
+ method flush f () =
+ Format.fprintf f "@[<v>";
+ let rec aux s =
+ if IdentMap.is_empty !to_flush then ()
+ else
+ let (t, (sch,_)) = IdentMap.min !to_flush in
+ to_flush := IdentMap.remove t !to_flush;
+ flushed := IdentMap.add t sch !flushed ;
+ let ty = Scheme.instantiate sch in
+ Format.fprintf f "@[%s %a = %a @]" s self#typeident t self#ty ty;
+ if IdentMap.is_empty !to_flush then ()
+ else aux "and"
+ in aux "type";
+ to_flush := IdentMap.empty;
+ flushed := IdentMap.empty;
+ Format.fprintf f "@]"
+end
View
11 libqmlcompil/qmlTypes.mli
@@ -441,3 +441,14 @@ val process_typenames_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotm
(** fails if there are duplicate type definitions *)
val check_no_duplicate_type_defs : QmlAst.code -> unit
+
+
+(** A class of printer which collects type identifiers printed in types and
+ present on the given [gamma]. Then the flush method prints definitions
+ corresponding to the collected identifiers. *)
+class pp_with_gamma :
+ gamma -> object
+ inherit QmlPrint.opa_printer
+ method flush : unit BaseFormat.pprinter
+ end
+

0 comments on commit 4d33289

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