(* if accept_anonymous_sum_type.contents then ty_sum ts else fail (List.hd ts) "Anonymous sum types are not yet supported in this version of the compiler. Please define the sum type and use the name from the definition instead of the anonymous sum type. (Note that, e.g, type expression \"private({a} / {b})\" contains an anonymous sum type!)" *)

|SA.TypeNamed (SA.Typeident s,tyl) ->

QA.TypeName (List.map ty tyl, Arg.typeident ~check:false s)

|SA.TypeExternal -> QA.TypeAbstract

|SA.TypeForall (vars, t) ->

QA.TypeForall

(List.map (function (SA.Flatvar v) ->Arg.typevar v) vars,

[], [], ty t)

|SA.TypeModulefields ->

letaux_module_field (s, t) =

Arg.add_local_scope ();

let t = ty t in

let(ty_vars, row_vars, col_vars)asvars=Arg.get_local_vars ()in

let t_quantified =

if vars = ([], [], []) then t

elseQA.TypeForall (ty_vars, row_vars, col_vars, t) in

Arg.remove_local_scope () ;

(s, t_quantified) in

let fields =List.map aux_module_field fields in

QA.TypeRecord(QA.TyRow(fields, None))

andty_sumts=

let ts', last =List.extract_last ts in

let ts, colvar =

match last with

|SA.SumVar (SA.Colvar v),_ -> ts', Some (Arg.colvar v)

|_ -> ts, Nonein

letis_TypeRecord=function

|SA.SumRecord (SA.TyRow (_, None)),_ -> true

|_ -> falsein

ifList.for_all is_TypeRecord ts then (

QA.TypeSum

(QA.TyCol

(List.map

(function

| (SA.SumRecord row,_) ->

let fields, rowvar = typerow row in

assert (rowvar =None) ;

fields

|_ -> assertfalse

) ts, colvar))

)

else (

assert (colvar =None) ;

QA.TypeSumSugar

(List.map

(function

| (SA.SumRecord row,_) -> ty_node (SA.TypeRecord row)

| (SA.SumName n,_) -> ty_node (SA.TypeNamed n)

| (SA.SumVar (SA.Colvar _),_) -> assertfalse) ts)

)

andtypearrowx= typearrow_aux (fst x)

andtypearrow_aux (row, t) =

letSA.TyRow (fields, rowvaro) = fst row in

assert (rowvaro =None);

QA.TypeArrow ((List.map (fun (_,x) -> ty x) fields), ty t)

andtyperecordrow=

let l,r=typerow row in

QA.TypeRecord (QA.TyRow (l, r))

andtyperow (SA.TyRow (fields, rowvaro)) =

let l =List.map (fun (s, t) -> (s, (ty t))) fields in

let r =Option.map (functionSA.Rowvarv ->Arg.rowvar v) rowvaro in

(l, r)

let typeident_aux =Arg.typeident

lettypeident?(check=true)(SA.Typeident i) = typeident_aux ~check i

lettypedefty_def=

let vars =

List.map

(functionSA.Flatvarvar ->Arg.typevar var)

ty_def.SurfaceAst.ty_def_params in

let visibility' =

(match ty_def.SurfaceAst.ty_def_visibility with

|SA.TDV_public -> QmlAst.TDV_public

|SA.TDV_abstract ->

QmlAst.TDV_abstract (ObjectFiles.get_current_package_name ())

|SA.TDV_private ->

QmlAst.TDV_private (ObjectFiles.get_current_package_name ())) in

letSA.Typeident ti = ty_def.SurfaceAst.ty_def_name in

{

QmlAst.ty_def_options = ty_def.SA.ty_def_options ;

QmlAst.ty_def_visibility = visibility' ;

QmlAst.ty_def_name =Arg.typeident ~check:false ti ;

QmlAst.ty_def_params = vars ;

QmlAst.ty_def_body = ty ty_def.SurfaceAst.ty_def_body ;

}

(* Note that the OPA annot [opa_annot] is only used for error messages