let rec ctyp =
              function
              | TyId (loc, i) ->
                  let li = long_type_ident i
                  in mktyp loc (Ptyp_constr (li, []))
              | TyAli (loc, t1, t2) ->
                  let (t, i) =
                    (match (t1, t2) with
                     | (t, TyQuo (_, s)) -> (t, s)
                     | (TyQuo (_, s), t) -> (t, s)
                     | _ -> error loc "invalid alias type")
                  in mktyp loc (Ptyp_alias ((ctyp t), i))
              | TyAny loc -> mktyp loc Ptyp_any
              | (TyApp (loc, _, _) as f) ->
                  let (f, al) = ctyp_fa [] f in
                  let (is_cls, li) = ctyp_long_id f
                  in
                    if is_cls
                    then mktyp loc (Ptyp_class (li, (List.map ctyp al), []))
                    else mktyp loc (Ptyp_constr (li, (List.map ctyp al)))
              | TyArr (loc, (TyLab (_, lab, t1)), t2) ->
                  mktyp loc (Ptyp_arrow (lab, (ctyp t1), (ctyp t2)))
              | TyArr (loc, (TyOlb (loc1, lab, t1)), t2) ->
                  let t1 =
                    TyApp (loc1,
                      (Ast.TyId (loc1, (Ast.IdLid (loc1, "option")))), t1)
                  in
                    mktyp loc
                      (Ptyp_arrow (("?" ^ lab), (ctyp t1), (ctyp t2)))
              | TyArr (loc, t1, t2) ->
                  mktyp loc (Ptyp_arrow ("", (ctyp t1), (ctyp t2)))
              | Ast.TyObj (loc, fl, Ast.RvNil->
                  mktyp loc (Ptyp_object (meth_list fl []))
              | Ast.TyObj (loc, fl, Ast.RvRowVar->
                  mktyp loc
                    (Ptyp_object (meth_list fl [ mkfield loc Pfield_var ]))
              | TyCls (loc, id) ->
                  mktyp loc (Ptyp_class ((ident id), [], []))
              | Ast.TyPkg (loc, pt) ->
                  let (i, cs) = package_type pt
                  in mktyp loc (Ptyp_package (i, cs))
              | TyLab (loc, _, _) ->
                  error loc "labelled type not allowed here"
              | TyMan (loc, _, _) ->
                  error loc "manifest type not allowed here"
              | TyOlb (loc, _, _) ->
                  error loc "labelled type not allowed here"
              | TyPol (loc, t1, t2) ->
                  mktyp loc (Ptyp_poly ((ty_var_list_of_ctyp t1), (ctyp t2)))
              | TyQuo (loc, s) -> mktyp loc (Ptyp_var s)
              | TyRec (loc, _) -> error loc "record type not allowed here"
              | TySum (loc, _) -> error loc "sum type not allowed here"
              | TyPrv (loc, _) -> error loc "private type not allowed here"
              | TyMut (loc, _) -> error loc "mutable type not allowed here"
              | TyOr (loc, _, _) ->
                  error loc "type1 | type2 not allowed here"
              | TyAnd (loc, _, _) ->
                  error loc "type1 and type2 not allowed here"
              | TyOf (loc, _, _) ->
                  error loc "type1 of type2 not allowed here"
              | TyCol (loc, _, _) ->
                  error loc "type1 : type2 not allowed here"
              | TySem (loc, _, _) ->
                  error loc "type1 ; type2 not allowed here"
              | Ast.TyTup (loc, (Ast.TySta (_, t1, t2))) ->
                  mktyp loc
                    (Ptyp_tuple
                       (List.map ctyp (list_of_ctyp t1 (list_of_ctyp t2 []))))
              | Ast.TyVrnEq (loc, t) ->
                  mktyp loc (Ptyp_variant ((row_field t), trueNone))
              | Ast.TyVrnSup (loc, t) ->
                  mktyp loc (Ptyp_variant ((row_field t), falseNone))
              | Ast.TyVrnInf (loc, t) ->
                  mktyp loc (Ptyp_variant ((row_field t), true, (Some [])))
              | Ast.TyVrnInfSup (loc, t, t') ->
                  mktyp loc
                    (Ptyp_variant ((row_field t), true,
                       (Some (name_tags t'))))
              | TyAnt (loc, _) -> error loc "antiquotation not allowed here"
              | TyOfAmp (_, _, _) | TyAmp (_, _, _) | TySta (_, _, _) |
                  TyCom (_, _, _) | TyVrn (_, _) | TyQuM (_, _) |
                  TyQuP (_, _) | TyDcl (_, _, _, _, _) |
                  TyObj (_, _, (RvAnt _)) | TyNil _ | TyTup (_, _) ->
                  assert false
            and row_field =
              function
              | Ast.TyNil _ -> []
              | Ast.TyVrn (_, i) -> [ Rtag (i, true, []) ]
              | Ast.TyOfAmp (_, (Ast.TyVrn (_, i)), t) ->
                  [ Rtag (i, true, (List.map ctyp (list_of_ctyp t []))) ]
              | Ast.TyOf (_, (Ast.TyVrn (_, i)), t) ->
                  [ Rtag (i, false, (List.map ctyp (list_of_ctyp t []))) ]
              | Ast.TyOr (_, t1, t2) -> (row_field t1) @ (row_field t2)
              | t -> [ Rinherit (ctyp t) ]
            and name_tags =
              function
              | Ast.TyApp (_, t1, t2) -> (name_tags t1) @ (name_tags t2)
              | Ast.TyVrn (_, s) -> [ s ]
              | _ -> assert false
            and meth_list fl acc =
              match fl with
              | Ast.TyNil _ -> acc
              | Ast.TySem (_, t1, t2) -> meth_list t1 (meth_list t2 acc)
              | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, lab)))), t) ->
                  (mkfield loc (Pfield (lab, (mkpolytype (ctyp t))))) :: acc
              | _ -> assert false
            and package_type_constraints wc acc =
              match wc with
              | Ast.WcNil _ -> acc
              | Ast.WcTyp (_, (Ast.TyId (_, (Ast.IdLid (_, id)))), ct) ->
                  (id, (ctyp ct)) :: acc
              | Ast.WcAnd (_, wc1, wc2) ->
                  package_type_constraints wc1
                    (package_type_constraints wc2 acc)
              | _ ->
                  error (loc_of_with_constr wc)
                    "unexpected `with constraint' for a package type"
            and package_type : module_type -> package_type =
              function
              | Ast.MtWit (_, (Ast.MtId (_, i)), wc) ->
                  ((long_uident i), (package_type_constraints wc []))
              | Ast.MtId (_, i) -> ((long_uident i), [])
              | mt -> error (loc_of_module_type mt) "unexpected package type"