Skip to content
Browse files

[fix] compiler, typer: fixing exportation of polymorphic cyclic type

  • Loading branch information...
1 parent b4e986a commit e8514a191b4a08ecfb58be2c3cdefa5532c2eef9 @BourgerieQuentin BourgerieQuentin committed
Showing with 30 additions and 9 deletions.
  1. +30 −9 libqmlcompil/typer_w/w_PublicExport.ml
View
39 libqmlcompil/typer_w/w_PublicExport.ml
@@ -91,7 +91,14 @@ let simple_type_to_qml_type initial_ty =
ty.W_Algebra.sty_mark <- W_Algebra.TM_export_cyclic ident;
QmlAst.TypeName ([], ident)
| W_Algebra.TM_export_cyclic ident ->
- QmlAst.TypeName ([], ident)
+ if QmlTypes.Env.TypeIdent.mem ident !cyclic_type then(
+ let sch = QmlTypes.Env.TypeIdent.find ~visibility_applies:false
+ ident !cyclic_type in
+ let (_, ty, _) = QmlGenericScheme.export_unsafe (fst sch) in
+ ty
+ )else (
+ QmlAst.TypeName ([], ident)
+ )
| W_Algebra.TM_not_seen
| W_Algebra.TM_export_seen_not_rec -> (
(* The type was never seen of just seen but as non-recursive. We will
@@ -159,30 +166,44 @@ let simple_type_to_qml_type initial_ty =
(* Now, export the body of the scheme. *)
let qml_body = rec_export_simple_type scheme.W_Algebra.body in
QmlAst.TypeForall
- (qml_ty_vars, qml_row_vars, qml_column_vars, qml_body)) in
-
+ (qml_ty_vars, qml_row_vars, qml_column_vars, qml_body))
+ in
(* Now we check if the current type is recursive, i.e if it
appeared in the subtree below it. If yes, then since QML type
algebra can't express recursive types, we raise an error.
If no, then we turn back its marker as "seen but non
recursive" (i.e. [TM_export_seen_not_rec]). *)
- (match ty.W_Algebra.sty_mark with
+ match ty.W_Algebra.sty_mark with
| W_Algebra.TM_export_cyclic ident ->
- let sch = QmlTypes.Scheme.definition ident exported_ty in
- cyclic_type := QmlTypes.Env.TypeIdent.add ident (sch, 0, QmlAst.TDV_public) !cyclic_type;
+ if not (QmlTypes.Env.TypeIdent.mem ident !cyclic_type) then (
+ let free = QmlTypes.freevars_of_ty exported_ty in
+ let typevar = QmlTypeVars.TypeVarSet.elements free.QmlTypeVars.typevar in
+ let exported_ty =
+ QmlAstWalk.Type.map
+ (function
+ | QmlAst.TypeName ([], i) when QmlAst.TypeIdent.equal ident i ->
+ QmlAst.TypeName (List.map (fun v -> QmlAst.TypeVar v) typevar, i)
+ | x -> x) exported_ty
+ in
+ let sch = QmlTypes.Scheme.definition ~typevar ident exported_ty in
+ cyclic_type := QmlTypes.Env.TypeIdent.add ident (sch, 0, QmlAst.TDV_public) !cyclic_type;
+ exported_ty
+ ) else (
+ exported_ty
+ )
| W_Algebra.TM_export_seen xtimes' ->
if !xtimes' = 1 then
ty.W_Algebra.sty_mark <- W_Algebra.TM_export_seen_not_rec
else
(* Should have broken above when encountering
[TM_export_seen]. *)
- assert false
+ assert false;
+ exported_ty
| _ ->
(* At least, the type must be marker as [TM_export_seen] with
1, since this is at what we initialized its marker just before
starting descending in its sub-term. *)
- assert false) ;
- exported_ty
+ assert false;
)
| _ (* Other markers. *) -> assert false

0 comments on commit e8514a1

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