Reintegrate the extension_point branch.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14044 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

118 files changed, 8493 insertions, 4223 deletions

diff --git a/.depend b/.depend
index 50b633748..1541c7a81 100644
--- a/.depend
+++ b/.depend
@@ -24,27 +24,31 @@ utils/terminfo.cmo : utils/terminfo.cmi
 utils/terminfo.cmx : utils/terminfo.cmi
 utils/warnings.cmo : utils/warnings.cmi
 utils/warnings.cmx : utils/warnings.cmi
-parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/longident.cmi \
+parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \
     parsing/location.cmi parsing/asttypes.cmi
+parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi
 parsing/asttypes.cmi : parsing/location.cmi
 parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi
 parsing/location.cmi : utils/warnings.cmi
 parsing/longident.cmi :
 parsing/parse.cmi : parsing/parsetree.cmi
-parsing/parser.cmi : parsing/parsetree.cmi parsing/longident.cmi \
-    parsing/location.cmi
+parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi
 parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \
     parsing/asttypes.cmi
 parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi \
     parsing/asttypes.cmi
 parsing/printast.cmi : parsing/parsetree.cmi
 parsing/syntaxerr.cmi : parsing/location.cmi
+parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \
+    parsing/location.cmi parsing/asttypes.cmi parsing/ast_helper.cmi
+parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \
+    parsing/location.cmx parsing/asttypes.cmi parsing/ast_helper.cmi
 parsing/ast_mapper.cmo : parsing/parsetree.cmi parsing/longident.cmi \
     parsing/location.cmi utils/config.cmi parsing/asttypes.cmi \
-    parsing/ast_mapper.cmi
+    parsing/ast_helper.cmi parsing/ast_mapper.cmi
 parsing/ast_mapper.cmx : parsing/parsetree.cmi parsing/longident.cmx \
     parsing/location.cmx utils/config.cmx parsing/asttypes.cmi \
-    parsing/ast_mapper.cmi
+    parsing/ast_helper.cmx parsing/ast_mapper.cmi
 parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
     parsing/location.cmi parsing/lexer.cmi
 parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \
@@ -61,10 +65,10 @@ parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \
     parsing/location.cmx parsing/lexer.cmx parsing/parse.cmi
 parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
     parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \
-    parsing/asttypes.cmi parsing/parser.cmi
+    parsing/asttypes.cmi parsing/ast_helper.cmi parsing/parser.cmi
 parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \
     parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \
-    parsing/asttypes.cmi parsing/parser.cmi
+    parsing/asttypes.cmi parsing/ast_helper.cmx parsing/parser.cmi
 parsing/pprintast.cmo : parsing/parsetree.cmi parsing/longident.cmi \
     parsing/location.cmi parsing/asttypes.cmi parsing/pprintast.cmi
 parsing/pprintast.cmx : parsing/parsetree.cmi parsing/longident.cmx \
@@ -120,11 +124,10 @@ typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
     typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/annot.cmi
 typing/typedecl.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
-    typing/includecore.cmi typing/ident.cmi typing/env.cmi \
-    parsing/asttypes.cmi
+    typing/includecore.cmi typing/ident.cmi typing/env.cmi
 typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \
-    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
-    typing/env.cmi parsing/asttypes.cmi
+    parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
 typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi
 typing/typedtreeMap.cmi : typing/typedtree.cmi
 typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi \
@@ -223,13 +226,13 @@ typing/parmatch.cmo : utils/warnings.cmi typing/types.cmi \
     parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \
     typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \
-    typing/parmatch.cmi
+    parsing/ast_helper.cmi typing/parmatch.cmi
 typing/parmatch.cmx : utils/warnings.cmx typing/types.cmx \
     typing/typedtree.cmx typing/subst.cmx typing/predef.cmx typing/path.cmx \
     parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \
     typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
-    typing/parmatch.cmi
+    parsing/ast_helper.cmx typing/parmatch.cmi
 typing/path.cmo : typing/ident.cmi typing/path.cmi
 typing/path.cmx : typing/ident.cmx typing/path.cmi
 typing/predef.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \
@@ -250,12 +253,12 @@ typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \
     parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
     typing/printtyp.cmi
-typing/printtyped.cmo : typing/typedtree.cmi typing/path.cmi \
-    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
-    parsing/asttypes.cmi typing/printtyped.cmi
-typing/printtyped.cmx : typing/typedtree.cmx typing/path.cmx \
-    parsing/longident.cmx parsing/location.cmx typing/ident.cmx \
-    parsing/asttypes.cmi typing/printtyped.cmi
+typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \
+    typing/path.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi
+typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \
+    typing/path.cmx parsing/longident.cmx parsing/location.cmx \
+    typing/ident.cmx parsing/asttypes.cmi typing/printtyped.cmi
 typing/stypes.cmo : typing/typedtree.cmi typing/printtyp.cmi \
     parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi
 typing/stypes.cmx : typing/typedtree.cmx typing/printtyp.cmx \
@@ -274,7 +277,7 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
     parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
-    typing/typeclass.cmi
+    parsing/ast_helper.cmi typing/typeclass.cmi
 typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \
     typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \
@@ -283,7 +286,7 @@ typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \
     parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \
     typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
-    typing/typeclass.cmi
+    parsing/ast_helper.cmx typing/typeclass.cmi
 typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
     typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
     typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
@@ -291,7 +294,8 @@ typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
     typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
     typing/cmt_format.cmi utils/clflags.cmi typing/btype.cmi \
-    parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi
+    parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \
+    typing/typecore.cmi
 typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \
     typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
@@ -299,7 +303,8 @@ typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
     typing/cmt_format.cmx utils/clflags.cmx typing/btype.cmx \
-    parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi
+    parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \
+    typing/typecore.cmi
 typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \
     typing/types.cmi typing/typedtree.cmi typing/subst.cmi \
     typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
@@ -307,7 +312,7 @@ typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \
     parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
-    typing/typedecl.cmi
+    parsing/ast_helper.cmi typing/typedecl.cmi
 typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/types.cmx typing/typedtree.cmx typing/subst.cmx \
     typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
@@ -315,21 +320,23 @@ typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \
     parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \
     typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
-    typing/typedecl.cmi
+    parsing/ast_helper.cmx typing/typedecl.cmi
 typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \
-    utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
-    typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/typedtree.cmi
+    parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
+    parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \
+    typing/typedtree.cmi
 typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \
-    utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
-    typing/ident.cmx typing/env.cmx parsing/asttypes.cmi typing/typedtree.cmi
+    parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
+    parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \
+    typing/typedtree.cmi
 typing/typedtreeIter.cmo : typing/typedtree.cmi parsing/asttypes.cmi \
     typing/typedtreeIter.cmi
 typing/typedtreeIter.cmx : typing/typedtree.cmx parsing/asttypes.cmi \
     typing/typedtreeIter.cmi
 typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \
-    parsing/asttypes.cmi typing/typedtreeMap.cmi
+    typing/typedtreeMap.cmi
 typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \
-    parsing/asttypes.cmi typing/typedtreeMap.cmi
+    typing/typedtreeMap.cmi
 typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
     typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
     typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \
@@ -358,12 +365,14 @@ typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \
     typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/path.cmi \
     parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
-    typing/btype.cmi parsing/asttypes.cmi typing/typetexp.cmi
+    typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
+    typing/typetexp.cmi
 typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \
     typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/path.cmx \
     parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \
-    typing/btype.cmx parsing/asttypes.cmi typing/typetexp.cmi
+    typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
+    typing/typetexp.cmi
 bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi
 bytecomp/bytelibrarian.cmi :
 bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi
@@ -1010,7 +1019,8 @@ toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \
     typing/ident.cmi toplevel/genprintval.cmi driver/errors.cmi \
     typing/env.cmi bytecomp/emitcode.cmi bytecomp/dll.cmi utils/consistbl.cmi \
     utils/config.cmi driver/compmisc.cmi utils/clflags.cmi \
-    bytecomp/bytegen.cmi typing/btype.cmi toplevel/toploop.cmi
+    bytecomp/bytegen.cmi typing/btype.cmi parsing/ast_helper.cmi \
+    toplevel/toploop.cmi
 toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \
     typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \
     bytecomp/translmod.cmx bytecomp/symtable.cmx bytecomp/simplif.cmx \
@@ -1023,7 +1033,8 @@ toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \
     typing/ident.cmx toplevel/genprintval.cmx driver/errors.cmx \
     typing/env.cmx bytecomp/emitcode.cmx bytecomp/dll.cmx utils/consistbl.cmx \
     utils/config.cmx driver/compmisc.cmx utils/clflags.cmx \
-    bytecomp/bytegen.cmx typing/btype.cmx toplevel/toploop.cmi
+    bytecomp/bytegen.cmx typing/btype.cmx parsing/ast_helper.cmx \
+    toplevel/toploop.cmi
 toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \
     toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \
     parsing/location.cmi driver/errors.cmi utils/config.cmi \
diff --git a/Makefile b/Makefile
index dae697a09..142170801 100644
--- a/Makefile
+++ b/Makefile
@@ -46,6 +46,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
   utils/consistbl.cmo
 
 PARSING=parsing/location.cmo parsing/longident.cmo \
+  parsing/ast_helper.cmo \
   parsing/syntaxerr.cmo parsing/parser.cmo \
   parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
   parsing/pprintast.cmo \
@@ -131,7 +132,7 @@ all:
 	$(MAKE) library
 	$(MAKE) ocaml
 	$(MAKE) otherlibraries $(OCAMLBUILDBYTE) $(CAMLP4OUT) $(WITH_DEBUGGER) \
-	  $(WITH_OCAMLDOC)
+	  $(WITH_OCAMLDOC) moretools
 
 # Compile everything the first time
 world:
@@ -705,6 +706,9 @@ clean::
 ocamltools: ocamlc ocamlyacc ocamllex asmcomp/cmx_format.cmi
 	cd tools; $(MAKE) all
 
+moretools: ocamlc compilerlibs/ocamltoplevel.cma
+	cd tools; $(MAKE) moretools
+
 ocamltoolsopt: ocamlopt
 	cd tools; $(MAKE) opt
 
@@ -854,7 +858,7 @@ distclean:
 .PHONY: coreboot defaultentry depend distclean install installopt
 .PHONY: library library-cross libraryopt
 .PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc
-.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt
+.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt moretools
 .PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries
 .PHONY: otherlibrariesopt package-macosx promote promote-cross
 .PHONY: restore runtime runtimeopt makeruntimeopt world world.opt
diff --git a/Makefile.nt b/Makefile.nt
index c46942ed8..32d760509 100644
--- a/Makefile.nt
+++ b/Makefile.nt
@@ -42,6 +42,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
   utils/consistbl.cmo
 
 PARSING=parsing/location.cmo parsing/longident.cmo \
+  parsing/ast_helper.cmo \
   parsing/syntaxerr.cmo parsing/parser.cmo \
   parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
   parsing/pprintast.cmo \
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 23d479831..2c62720e8 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1941,7 +1941,7 @@ let rec emit_constant symb cst cont =
   match cst with
     Const_base(Const_float s) ->
       Cint(float_header) :: Cdefine_symbol symb :: Cdouble s :: cont
-  | Const_base(Const_string s) | Const_immstring s ->
+  | Const_base(Const_string (s, _)) | Const_immstring s ->
       Cint(string_header (String.length s)) ::
       Cdefine_symbol symb ::
       emit_string_constant s cont
@@ -1984,7 +1984,7 @@ and emit_constant_field field cont =
       let lbl = Compilenv.new_const_label() in
       (Clabel_address lbl,
        Cint(float_header) :: Cdefine_label lbl :: Cdouble s :: cont)
-  | Const_base(Const_string s) ->
+  | Const_base(Const_string (s, _)) ->
       let lbl = Compilenv.new_const_label() in
       (Clabel_address lbl,
        Cint(string_header (String.length s)) :: Cdefine_label lbl ::
@@ -2467,7 +2467,7 @@ let reference_symbols namelist =
 let global_data name v =
   Cdata(Cglobal_symbol name ::
           emit_constant name
-          (Const_base (Const_string (Marshal.to_string v []))) [])
+          (Const_base (Const_string (Marshal.to_string v [], None))) [])
 
 let globals_map v = global_data "caml_globals_map" v
 
@@ -2506,7 +2506,8 @@ let predef_exception name =
   let bucketname = "caml_bucket_" ^ name in
   let symname = "caml_exn_" ^ name in
   Cdata(Cglobal_symbol symname ::
-        emit_constant symname (Const_block(0,[Const_base(Const_string name)]))
+        emit_constant symname
+          (Const_block(0,[Const_base(Const_string (name, None))]))
         [ Cglobal_symbol bucketname;
           Cint(block_header 0 1);
           Cdefine_symbol bucketname;
diff --git a/boot/ocamlc b/boot/ocamlc
index 512627abd..f2ed6fd49 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index fc83f428a..05cd295f4 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 113a88612..bb4ebc652 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 42e761a91..2676d03a4 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -162,19 +162,19 @@ let make_default matcher env =
 let ctx_matcher p =
   let p = normalize_pat p in
   match p.pat_desc with
-  | Tpat_construct (_, cstr,omegas,_) ->
+  | Tpat_construct (_, cstr,omegas) ->
       begin match cstr.cstr_tag with
       | Cstr_exception _ -> (* exception matching *)
           let nargs = List.length omegas in
           (fun q rem -> match q.pat_desc with
-          | Tpat_construct (_, cstr',args,_)
+          | Tpat_construct (_, cstr',args)
             when List.length args = nargs ->
                 p,args @ rem
           | Tpat_any -> p,omegas @ rem
           | _ -> raise NoMatch)
       | _ ->
           (fun q rem -> match q.pat_desc with
-          | Tpat_construct (_, cstr',args,_)
+          | Tpat_construct (_, cstr',args)
             when cstr.cstr_tag=cstr'.cstr_tag ->
               p,args @ rem
           | Tpat_any -> p,omegas @ rem
@@ -500,12 +500,12 @@ let up_ok_action act1 act2 =
 
 (* Nothing is kown about exeception patterns, because of potential rebind *)
 let rec exc_inside p = match p.pat_desc with
-  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_,_) -> true
+  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_) -> true
   | Tpat_any|Tpat_constant _|Tpat_var _
-  | Tpat_construct (_,_,[],_)
+  | Tpat_construct (_,_,[])
   | Tpat_variant (_,None,_)
     -> false
-  | Tpat_construct (_,_,ps,_) 
+  | Tpat_construct (_,_,ps)
   | Tpat_tuple ps
   | Tpat_array ps
       -> exc_insides ps
@@ -662,7 +662,7 @@ let rec extract_vars r p = match p.pat_desc with
     List.fold_left
       (fun r (_, _, p) -> extract_vars r p)
       r lpats
-| Tpat_construct (_, _, pats,_) ->
+| Tpat_construct (_, _, pats) ->
     List.fold_left extract_vars r pats
 | Tpat_array pats ->
     List.fold_left extract_vars r pats
@@ -707,7 +707,7 @@ let pm_free_variables {cases=cases} =
 
 (* Basic grouping predicates *)
 let pat_as_constr = function
-  | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr
+  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr
   | _ -> fatal_error "Matching.pat_as_constr"
 
 let group_constant = function
@@ -715,7 +715,7 @@ let group_constant = function
   | _                           -> false
 
 and group_constructor = function
-  | {pat_desc = Tpat_construct (_,_,_,_)} -> true
+  | {pat_desc = Tpat_construct (_,_,_)} -> true
   | _ -> false
 
 and group_variant = function
@@ -965,7 +965,7 @@ and split_constr cls args def k =
   let ex_pat = what_is_cases cls in
   match ex_pat.pat_desc with
   | Tpat_any -> precompile_var args cls def k
-  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_,_) ->
+  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_) ->
       split_naive cls args def k
   | _ ->
 
@@ -1075,7 +1075,7 @@ and dont_precompile_var args cls def k =
 and is_exc p = match p.pat_desc with
 | Tpat_or (p1,p2,_) -> is_exc p1 || is_exc p2
 | Tpat_alias (p,v,_) -> is_exc p
-| Tpat_construct (_,{cstr_tag = Cstr_exception _},_,_) -> true
+| Tpat_construct (_,{cstr_tag = Cstr_exception _},_) -> true
 | _ -> false
 
 and precompile_or argo cls ors args def k = match ors with
@@ -1255,14 +1255,13 @@ let make_field_args binding_kind arg first_pos last_pos argl =
   in make_args first_pos
 
 let get_key_constr = function
-  | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr.cstr_tag
+  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag
   | _ -> assert false
 
 let get_args_constr p rem = match p with
-| {pat_desc=Tpat_construct (_, _, args, _)} -> args @ rem
+| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem
 | _ -> assert false
 
-
 let matcher_constr cstr = match cstr.cstr_arity with
 | 0 ->
     let rec matcher_rec q rem = match q.pat_desc with
@@ -1273,7 +1272,7 @@ let matcher_constr cstr = match cstr.cstr_arity with
           with
           | NoMatch -> matcher_rec p2 rem
         end
-    | Tpat_construct (_, cstr1, [],_) when cstr.cstr_tag = cstr1.cstr_tag ->
+    | Tpat_construct (_, cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag ->
         rem
     | Tpat_any -> rem
     | _ -> raise NoMatch in
@@ -1294,7 +1293,7 @@ let matcher_constr cstr = match cstr.cstr_arity with
             rem
         | _, _ -> assert false
         end
-    | Tpat_construct (_, cstr1, [arg],_)
+    | Tpat_construct (_, cstr1, [arg])
       when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem
     | Tpat_any -> omega::rem
     | _ -> raise NoMatch in
@@ -1302,7 +1301,7 @@ let matcher_constr cstr = match cstr.cstr_arity with
 | _ ->
     fun q rem -> match q.pat_desc with
     | Tpat_or (_,_,_) -> raise OrPat
-    | Tpat_construct (_, cstr1, args,_)
+    | Tpat_construct (_, cstr1, args)
       when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
     | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
     | _        -> raise NoMatch
@@ -2569,7 +2568,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with
         divide_constant
         (combine_constant arg cst partial)
         ctx pm
-  | Tpat_construct (_, cstr, _, _) ->
+  | Tpat_construct (_, cstr, _) ->
       compile_test
         (compile_match repr partial) partial
         divide_constructor (combine_constructor arg pat cstr partial)
@@ -2632,7 +2631,7 @@ let find_in_pat pred =
     begin match p.pat_desc with
     | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p ->
         find_rec p
-    | Tpat_tuple ps|Tpat_construct (_,_,ps,_) | Tpat_array ps ->
+    | Tpat_tuple ps|Tpat_construct (_,_,ps) | Tpat_array ps ->
         List.exists find_rec ps
     | Tpat_record (lpats,_) ->
         List.exists
@@ -2732,7 +2731,7 @@ let partial_function loc () =
   Lprim(Praise, [Lprim(Pmakeblock(0, Immutable),
           [transl_path Predef.path_match_failure;
            Lconst(Const_block(0,
-              [Const_base(Const_string fname);
+              [Const_base(Const_string (fname, None));
                Const_base(Const_int line);
                Const_base(Const_int char)]))])])
 
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index 65316700a..8774e72b8 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -20,7 +20,7 @@ open Lambda
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
   | Const_base(Const_char c) -> fprintf ppf "%C" c
-  | Const_base(Const_string s) -> fprintf ppf "%S" s
+  | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
   | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
   | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index 63374f820..412c1ab09 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -140,7 +140,7 @@ let init () =
         try List.assoc name Predef.builtin_values
         with Not_found -> fatal_error "Symtable.init" in
       let c = slot_for_setglobal id in
-      let cst = Const_block(0, [Const_base(Const_string name)]) in
+      let cst = Const_block(0, [Const_base(Const_string (name, None))]) in
       literal_table := (c, cst) :: !literal_table)
     Runtimedef.builtin_exceptions;
   (* Initialize the known C primitives *)
@@ -202,7 +202,7 @@ let ls_patch_object = gen_patch_object LongString.set
 let rec transl_const = function
     Const_base(Const_int i) -> Obj.repr i
   | Const_base(Const_char c) -> Obj.repr c
-  | Const_base(Const_string s) -> Obj.repr s
+  | Const_base(Const_string (s, _)) -> Obj.repr s
   | Const_base(Const_float f) -> Obj.repr (float_of_string f)
   | Const_base(Const_int32 i) -> Obj.repr i
   | Const_base(Const_int64 i) -> Obj.repr i
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index ec40912c8..0b3bd45ef 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -109,6 +109,12 @@ let create_object cl obj init =
                            [obj; Lvar obj'; Lvar cl]))))
   end
 
+let name_pattern default p =
+  match p.pat_desc with
+  | Tpat_var (id, _) -> id
+  | Tpat_alias(p, id, _) -> id
+  | _ -> Ident.create default
+
 let rec build_object_init cl_table obj params inh_init obj_init cl =
   match cl.cl_desc with
     Tcl_ident ( path, _, _) ->
@@ -126,18 +132,18 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
           List.fold_right
             (fun field (inh_init, obj_init, has_init) ->
                match field.cf_desc with
-                 Tcf_inher (_, cl, _, _, _) ->
+                 Tcf_inherit (_, cl, _, _, _) ->
                    let (inh_init, obj_init') =
                      build_object_init cl_table (Lvar obj) [] inh_init
                        (fun _ -> lambda_unit) cl
                    in
                    (inh_init, lsequence obj_init' obj_init, true)
-               | Tcf_val (_, _, _, id, Tcfk_concrete exp, _) ->
+               | Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
                    (inh_init, lsequence (set_inst_var obj id exp) obj_init,
                     has_init)
-               | Tcf_meth _ | Tcf_val _ | Tcf_constr _ ->
+               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ ->
                    (inh_init, obj_init, has_init)
-               | Tcf_init _ ->
+               | Tcf_initializer _ ->
                    (inh_init, obj_init, true)
             )
             str.cstr_fields
@@ -156,7 +162,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
       in
       (inh_init,
        let build params rem =
-         let param = name_pattern "param" [pat, ()] in
+         let param = name_pattern "param" pat in
          Lfunction (Curried, param::params,
                     Matching.for_function
                       pat.pat_loc None (Lvar param) [pat, rem] partial)
@@ -262,33 +268,33 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
         List.fold_right
           (fun field (inh_init, cl_init, methods, values) ->
             match field.cf_desc with
-              Tcf_inher (_, cl, _, vals, meths) ->
+              Tcf_inherit (_, cl, _, vals, meths) ->
                 let cl_init = output_methods cla methods cl_init in
                 let inh_init, cl_init =
                   build_class_init cla false
                     (vals, meths_super cla str.cstr_meths meths)
                     inh_init cl_init msubst top cl in
                 (inh_init, cl_init, [], values)
-            | Tcf_val (name, _, _, id, exp, over) ->
-                let values = if over then values else (name, id) :: values in
+            | Tcf_val (name, _, id, _, over) ->
+                let values = if over then values else (name.txt, id) :: values in
                 (inh_init, cl_init, methods, values)
-            | Tcf_meth (_, _, _, Tcfk_virtual _, _)
-            | Tcf_constr _
+            | Tcf_method (_, _, Tcfk_virtual _)
+            | Tcf_constraint _
               ->
                 (inh_init, cl_init, methods, values)
-            | Tcf_meth (name, _, _, Tcfk_concrete exp, over) ->
+            | Tcf_method (name, _, Tcfk_concrete (_, exp)) ->
                 let met_code = msubst true (transl_exp exp) in
                 let met_code =
                   if !Clflags.native_code && List.length met_code = 1 then
                     (* Force correct naming of method for profiles *)
-                    let met = Ident.create ("method_" ^ name) in
+                    let met = Ident.create ("method_" ^ name.txt) in
                     [Llet(Strict, met, List.hd met_code, Lvar met)]
                   else met_code
                 in
                 (inh_init, cl_init,
-                 Lvar (Meths.find name str.cstr_meths) :: met_code @ methods,
+                 Lvar (Meths.find name.txt str.cstr_meths) :: met_code @ methods,
                  values)
-            | Tcf_init exp ->
+            | Tcf_initializer exp ->
                 (inh_init,
                  Lsequence(mkappl (oo_prim "add_initializer",
                                    Lvar cla :: msubst false (transl_exp exp)),
@@ -396,7 +402,7 @@ let rec transl_class_rebind obj_init cl vf =
   | Tcl_fun (_, pat, _, cl, partial) ->
       let path, obj_init = transl_class_rebind obj_init cl vf in
       let build params rem =
-        let param = name_pattern "param" [pat, ()] in
+        let param = name_pattern "param" pat in
         Lfunction (Curried, param::params,
                    Matching.for_function
                      pat.pat_loc None (Lvar param) [pat, rem] partial)
@@ -416,7 +422,7 @@ let rec transl_class_rebind obj_init cl vf =
       let path, obj_init = transl_class_rebind obj_init cl' vf in
       let rec check_constraint = function
           Cty_constr(path', _, _) when Path.same path path' -> ()
-        | Cty_fun (_, _, cty) -> check_constraint cty
+        | Cty_arrow (_, _, cty) -> check_constraint cty
         | _ -> raise Exit
       in
       check_constraint cl.cl_type;
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 36b79daa4..86f0bf4fa 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -333,10 +333,10 @@ let transl_prim loc prim args =
          simplify_constant_constructor) =
       Hashtbl.find comparisons_table prim_name in
     begin match args with
-      [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}]
+      [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}]
       when simplify_constant_constructor ->
         intcomp
-    | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}; arg2]
+    | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}; arg2]
       when simplify_constant_constructor ->
         intcomp
     | [arg1; {exp_desc = Texp_variant(_, None)}]
@@ -495,7 +495,7 @@ let extract_float = function
 
 let rec name_pattern default = function
     [] -> Ident.create default
-  | (p, e) :: rem ->
+  | {c_lhs=p; _} :: rem ->
       match p.pat_desc with
         Tpat_var (id, _) -> id
       | Tpat_alias(p, id, _) -> id
@@ -503,24 +503,27 @@ let rec name_pattern default = function
 
 (* Push the default values under the functional abstractions *)
 
-let rec push_defaults loc bindings pat_expr_list partial =
-  match pat_expr_list with
-    [pat, ({exp_desc = Texp_function(l, pl,partial)} as exp)] ->
+let rec push_defaults loc bindings cases partial =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function(l, pl,partial)} as exp}] ->
       let pl = push_defaults exp.exp_loc bindings pl partial in
-      [pat, {exp with exp_desc = Texp_function(l, pl, partial)}]
-  | [pat, {exp_desc = Texp_let
-             (Default, cases, ({exp_desc = Texp_function _} as e2))}] ->
-      push_defaults loc (cases :: bindings) [pat, e2] partial
-  | [pat, exp] ->
+      [{c_lhs=pat; c_guard=None; c_rhs={exp with exp_desc = Texp_function(l, pl, partial)}}]
+  | [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_attributes=[{txt="#default"},_];
+             exp_desc = Texp_let
+               (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}] ->
+      push_defaults loc (binds :: bindings) [{c_lhs=pat;c_guard=None;c_rhs=e2}] partial
+  | [case] ->
       let exp =
         List.fold_left
-          (fun exp cases ->
-            {exp with exp_desc = Texp_let(Nonrecursive, cases, exp)})
-          exp bindings
+          (fun exp binds ->
+            {exp with exp_desc = Texp_let(Nonrecursive, binds, exp)})
+          case.c_rhs bindings
       in
-      [pat, exp]
-  | (pat, exp) :: _ when bindings <> [] ->
-      let param = name_pattern "param" pat_expr_list in
+      [{case with c_rhs=exp}]
+  | {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
+      let param = name_pattern "param" cases in
       let name = Ident.name param in
       let exp =
         { exp with exp_loc = loc; exp_desc =
@@ -530,12 +533,12 @@ let rec push_defaults loc bindings pat_expr_list partial =
                           {val_type = pat.pat_type; val_kind = Val_reg;
                            Types.val_loc = Location.none;
                           })},
-             pat_expr_list, partial) }
+             cases, partial) }
       in
       push_defaults loc bindings
-        [{pat with pat_desc = Tpat_var (param, mknoloc name)}, exp] Total
+        [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)}; c_guard=None; c_rhs=exp}] Total
   | _ ->
-      pat_expr_list
+      cases
 
 (* Insertion of debugging events *)
 
@@ -585,7 +588,7 @@ let assert_failed exp =
     (Lprim(Pmakeblock(0, Immutable),
           [transl_path Predef.path_assert_failure;
            Lconst(Const_block(0,
-              [Const_base(Const_string fname);
+              [Const_base(Const_string (fname, None));
                Const_base(Const_int line);
                Const_base(Const_int char)]))]))])
 ;;
@@ -705,7 +708,7 @@ and transl_exp0 e =
       with Not_constant ->
         Lprim(Pmakeblock(0, Immutable), ll)
       end
-  | Texp_construct(_, cstr, args, _) ->
+  | Texp_construct(_, cstr, args) ->
       let ll = transl_list args in
       begin match cstr.cstr_tag with
         Cstr_constant n ->
@@ -782,10 +785,6 @@ and transl_exp0 e =
   | Texp_for(param, _, low, high, dir, body) ->
       Lfor(param, transl_exp low, transl_exp high, dir,
            event_before body (transl_exp body))
-  | Texp_when(cond, body) ->
-      event_before cond
-        (Lifthenelse(transl_exp cond, event_before body (transl_exp body),
-                     staticfail))
   | Texp_send(_, _, Some exp) -> transl_exp exp
   | Texp_send(expr, met, None) ->
       let obj = transl_exp expr in
@@ -818,11 +817,12 @@ and transl_exp0 e =
       Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body)
   | Texp_pack modl ->
       !transl_module Tcoerce_none None modl
+  | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} ->
+      assert_failed e
   | Texp_assert (cond) ->
       if !Clflags.noassert
       then lambda_unit
       else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e)
-  | Texp_assertfalse -> assert_failed e
   | Texp_lazy e ->
       (* when e needs no computation (constants, identifiers, ...), we
          optimize the translation just as Lazy.lazy_from_val would
@@ -833,7 +833,7 @@ and transl_exp0 e =
           ( Const_int _ | Const_char _ | Const_string _
           | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
       | Texp_function(_, _, _)
-      | Texp_construct (_, {cstr_arity = 0}, _, _)
+      | Texp_construct (_, {cstr_arity = 0}, _)
         -> transl_exp e
       | Texp_constant(Const_float _) ->
           Lprim(Pmakeblock(Obj.forward_tag, Immutable), [transl_exp e])
@@ -880,18 +880,29 @@ and transl_exp0 e =
         { cl_desc = Tcl_structure cs;
           cl_loc = e.exp_loc;
           cl_type = Cty_signature cty;
-          cl_env = e.exp_env }
+          cl_env = e.exp_env;
+          cl_attributes = [];
+         }
 
 and transl_list expr_list =
   List.map transl_exp expr_list
 
-and transl_cases pat_expr_list =
-  List.map
-    (fun (pat, expr) -> (pat, event_before expr (transl_exp expr)))
-    pat_expr_list
+and transl_guard guard rhs =
+  let expr = event_before rhs (transl_exp rhs) in
+  match guard with
+  | None -> expr
+  | Some cond ->
+      event_before cond (Lifthenelse(transl_exp cond, expr, staticfail))
+
+and transl_case {c_lhs; c_guard; c_rhs} =
+  c_lhs, transl_guard c_guard c_rhs
+
+and transl_cases cases =
+  List.map transl_case cases
 
 and transl_tupled_cases patl_expr_list =
-  List.map (fun (patl, expr) -> (patl, transl_exp expr)) patl_expr_list
+  List.map (fun (patl, guard, expr) -> (patl, transl_guard guard expr))
+    patl_expr_list
 
 and transl_apply lam sargs loc =
   let lapply funct args =
@@ -943,56 +954,58 @@ and transl_apply lam sargs loc =
   in
   build_apply lam [] (List.map (fun (l, x,o) -> may_map transl_exp x, o) sargs)
 
-and transl_function loc untuplify_fn repr partial pat_expr_list =
-  match pat_expr_list with
-    [pat, ({exp_desc = Texp_function(_, pl,partial')} as exp)]
+and transl_function loc untuplify_fn repr partial cases =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function(_, pl,partial')} as exp}]
     when Parmatch.fluid pat ->
-      let param = name_pattern "param" pat_expr_list in
+      let param = name_pattern "param" cases in
       let ((_, params), body) =
         transl_function exp.exp_loc false repr partial' pl in
       ((Curried, param :: params),
        Matching.for_function loc None (Lvar param) [pat, body] partial)
-  | ({pat_desc = Tpat_tuple pl}, _) :: _ when untuplify_fn ->
+  | {c_lhs={pat_desc = Tpat_tuple pl}} :: _ when untuplify_fn ->
       begin try
         let size = List.length pl in
         let pats_expr_list =
           List.map
-            (fun (pat, expr) -> (Matching.flatten_pattern size pat, expr))
-            pat_expr_list in
+            (fun {c_lhs; c_guard; c_rhs} ->
+              (Matching.flatten_pattern size c_lhs, c_guard, c_rhs))
+            cases in
         let params = List.map (fun p -> Ident.create "param") pl in
         ((Tupled, params),
          Matching.for_tupled_function loc params
            (transl_tupled_cases pats_expr_list) partial)
       with Matching.Cannot_flatten ->
-        let param = name_pattern "param" pat_expr_list in
+        let param = name_pattern "param" cases in
         ((Curried, [param]),
          Matching.for_function loc repr (Lvar param)
-           (transl_cases pat_expr_list) partial)
+           (transl_cases cases) partial)
       end
   | _ ->
-      let param = name_pattern "param" pat_expr_list in
+      let param = name_pattern "param" cases in
       ((Curried, [param]),
        Matching.for_function loc repr (Lvar param)
-         (transl_cases pat_expr_list) partial)
+         (transl_cases cases) partial)
 
 and transl_let rec_flag pat_expr_list body =
   match rec_flag with
-    Nonrecursive | Default ->
+    Nonrecursive ->
       let rec transl = function
         [] ->
           body
-      | (pat, expr) :: rem ->
+      | {vb_pat=pat; vb_expr=expr} :: rem ->
           Matching.for_let pat.pat_loc (transl_exp expr) pat (transl rem)
       in transl pat_expr_list
   | Recursive ->
       let idlist =
         List.map
-          (fun (pat, expr) -> match pat.pat_desc with
+          (fun {vb_pat=pat} -> match pat.pat_desc with
               Tpat_var (id,_) -> id
             | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id
             | _ -> raise(Error(pat.pat_loc, Illegal_letrec_pat)))
         pat_expr_list in
-      let transl_case (pat, expr) id =
+      let transl_case {vb_pat=pat; vb_expr=expr} id =
         let lam = transl_exp expr in
         if not (check_recursive_lambda idlist lam) then
           raise(Error(expr.exp_loc, Illegal_letrec_expr));
@@ -1083,12 +1096,13 @@ let transl_let rec_flag pat_expr_list body =
 
 (* Compile an exception definition *)
 
-let transl_exception id path decl =
+let transl_exception path decl =
   let name =
     match path with
-      None -> Ident.name id
+      None -> Ident.name decl.cd_id
     | Some p -> Path.name p in
-  Lprim(Pmakeblock(0, Immutable), [Lconst(Const_base(Const_string name))])
+  Lprim(Pmakeblock(0, Immutable),
+        [Lconst(Const_base(Const_string (name,None)))])
 
 (* Error report *)
 
diff --git a/bytecomp/translcore.mli b/bytecomp/translcore.mli
index f766cdcf2..842ed78dc 100644
--- a/bytecomp/translcore.mli
+++ b/bytecomp/translcore.mli
@@ -17,16 +17,13 @@ open Asttypes
 open Typedtree
 open Lambda
 
-val name_pattern: string -> (pattern * 'a) list -> Ident.t
-
 val transl_exp: expression -> lambda
 val transl_apply: lambda -> (label * expression option * optional) list
                   -> Location.t -> lambda
-val transl_let:
-      rec_flag -> (pattern * expression) list -> lambda -> lambda
+val transl_let: rec_flag -> value_binding list -> lambda -> lambda
 val transl_primitive: Location.t -> Primitive.description -> lambda
 val transl_exception:
-      Ident.t -> Path.t option -> exception_declaration -> lambda
+      Path.t option -> constructor_declaration -> lambda
 
 val check_recursive_lambda: Ident.t list -> lambda -> bool
 
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 3b94a9153..0c26ecd07 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -109,7 +109,7 @@ let mod_prim name =
 let undefined_location loc =
   let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
   Lconst(Const_block(0,
-                     [Const_base(Const_string fname);
+                     [Const_base(Const_string (fname, None));
                       Const_base(Const_int line);
                       Const_base(Const_int char)]))
 
@@ -222,10 +222,10 @@ let eval_rec_bindings bindings cont =
 let compile_recmodule compile_rhs bindings cont =
   eval_rec_bindings
     (reorder_rec_bindings
-      (List.map
-        (fun ( id, _, _, modl) ->
-                  (id, modl.mod_loc, init_shape modl, compile_rhs id modl))
-        bindings))
+       (List.map
+          (fun {mb_id=id; mb_expr=modl; _} ->
+            (id, modl.mod_loc, init_shape modl, compile_rhs id modl))
+          bindings))
     cont
 
 (* Extract the list of "value" identifiers bound by a signature.
@@ -298,39 +298,38 @@ and transl_structure fields cc rootpath = function
       end
   | item :: rem ->
       match item.str_desc with
-      | Tstr_eval expr ->
+      | Tstr_eval (expr, _) ->
       Lsequence(transl_exp expr, transl_structure fields cc rootpath rem)
   | Tstr_value(rec_flag, pat_expr_list) ->
       let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
       transl_let rec_flag pat_expr_list
                  (transl_structure ext_fields cc rootpath rem)
-  | Tstr_primitive(id, _, descr) ->
+  | Tstr_primitive descr ->
       record_primitive descr.val_val;
       transl_structure fields cc rootpath rem
   | Tstr_type(decls) ->
       transl_structure fields cc rootpath rem
-  | Tstr_exception( id, _, decl) ->
-      Llet(Strict, id, transl_exception id (field_path rootpath id) decl,
+  | Tstr_exception decl ->
+      let id = decl.cd_id in
+      Llet(Strict, id, transl_exception (field_path rootpath id) decl,
            transl_structure (id :: fields) cc rootpath rem)
-  | Tstr_exn_rebind( id, _, path, _) ->
+  | Tstr_exn_rebind( id, _, path, _, _) ->
       Llet(Strict, id, transl_path path,
            transl_structure (id :: fields) cc rootpath rem)
-  | Tstr_module( id, _, modl) ->
+  | Tstr_module mb ->
+      let id = mb.mb_id in
       Llet(Strict, id,
-           transl_module Tcoerce_none (field_path rootpath id) modl,
+           transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr,
            transl_structure (id :: fields) cc rootpath rem)
   | Tstr_recmodule bindings ->
       let ext_fields =
-        List.rev_append (List.map (fun (id, _,_,_) -> id) bindings) fields in
+        List.rev_append (List.map (fun mb -> mb.mb_id) bindings) fields
+      in
       compile_recmodule
         (fun id modl ->
           transl_module Tcoerce_none (field_path rootpath id) modl)
         bindings
         (transl_structure ext_fields cc rootpath rem)
-  | Tstr_modtype(id, _, decl) ->
-      transl_structure fields cc rootpath rem
-  | Tstr_open _ ->
-      transl_structure fields cc rootpath rem
   | Tstr_class cl_list ->
       let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in
       Lletrec(List.map
@@ -340,9 +339,7 @@ and transl_structure fields cc rootpath = function
                   (id, transl_class ids id meths cl vf ))
                 cl_list,
               transl_structure (List.rev ids @ fields) cc rootpath rem)
-  | Tstr_class_type cl_list ->
-      transl_structure fields cc rootpath rem
-  | Tstr_include(modl, sg) ->
+  | Tstr_include(modl, sg, _) ->
       let ids = bound_value_identifiers sg in
       let mid = Ident.create "include" in
       let rec rebind_idents pos newfields = function
@@ -354,6 +351,12 @@ and transl_structure fields cc rootpath = function
       Llet(Strict, mid, transl_module Tcoerce_none None modl,
            rebind_idents 0 fields ids)
 
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_structure fields cc rootpath rem
+
 (* Update forward declaration in Translcore *)
 let _ =
   Translcore.transl_module := transl_module
@@ -376,22 +379,23 @@ let rec defined_idents = function
     [] -> []
   | item :: rem ->
     match item.str_desc with
-    | Tstr_eval expr -> defined_idents rem
+    | Tstr_eval (expr, _) -> defined_idents rem
     | Tstr_value(rec_flag, pat_expr_list) ->
       let_bound_idents pat_expr_list @ defined_idents rem
-    | Tstr_primitive(id, _, descr) -> defined_idents rem
+    | Tstr_primitive desc -> defined_idents rem
     | Tstr_type decls -> defined_idents rem
-    | Tstr_exception(id, _, decl) -> id :: defined_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> id :: defined_idents rem
-    | Tstr_module(id, _, modl) -> id :: defined_idents rem
+    | Tstr_exception decl -> decl.cd_id :: defined_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> id :: defined_idents rem
+    | Tstr_module mb -> mb.mb_id :: defined_idents rem
     | Tstr_recmodule decls ->
-      List.map (fun (id, _, _, _) -> id) decls @ defined_idents rem
-    | Tstr_modtype(id, _, decl) -> defined_idents rem
+      List.map (fun mb -> mb.mb_id) decls @ defined_idents rem
+    | Tstr_modtype _ -> defined_idents rem
     | Tstr_open _ -> defined_idents rem
     | Tstr_class cl_list ->
       List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem
     | Tstr_class_type cl_list -> defined_idents rem
-    | Tstr_include(modl, sg) -> bound_value_identifiers sg @ defined_idents rem
+    | Tstr_include(modl, sg, _) -> bound_value_identifiers sg @ defined_idents rem
+    | Tstr_attribute _ -> []
 
 (* second level idents (module M = struct ... let id = ... end),
    and all sub-levels idents *)
@@ -399,44 +403,46 @@ let rec more_idents = function
     [] -> []
   | item :: rem ->
     match item.str_desc with
-    | Tstr_eval expr -> more_idents rem
+    | Tstr_eval (expr, _attrs) -> more_idents rem
     | Tstr_value(rec_flag, pat_expr_list) -> more_idents rem
-    | Tstr_primitive(id, _, descr) -> more_idents rem
+    | Tstr_primitive _ -> more_idents rem
     | Tstr_type decls -> more_idents rem
-    | Tstr_exception(id, _, decl) -> more_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> more_idents rem
+    | Tstr_exception _ -> more_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> more_idents rem
     | Tstr_recmodule decls -> more_idents rem
-    | Tstr_modtype(id, _, decl) -> more_idents rem
+    | Tstr_modtype _ -> more_idents rem
     | Tstr_open _ -> more_idents rem
     | Tstr_class cl_list -> more_idents rem
     | Tstr_class_type cl_list -> more_idents rem
-    | Tstr_include(modl, _) -> more_idents rem
-    | Tstr_module(id, _, { mod_desc = Tmod_structure str }) ->
-      all_idents str.str_items @ more_idents rem
-    | Tstr_module(id, _, _) -> more_idents rem
+    | Tstr_include(modl, _, _) -> more_idents rem
+    | Tstr_module {mb_expr={mod_desc = Tmod_structure str}} ->
+        all_idents str.str_items @ more_idents rem
+    | Tstr_module _ -> more_idents rem
+    | Tstr_attribute _ -> []
 
 and all_idents = function
     [] -> []
   | item :: rem ->
     match item.str_desc with
-    | Tstr_eval expr -> all_idents rem
+    | Tstr_eval (expr, _attrs) -> all_idents rem
     | Tstr_value(rec_flag, pat_expr_list) ->
       let_bound_idents pat_expr_list @ all_idents rem
-    | Tstr_primitive(id, _, descr) -> all_idents rem
+    | Tstr_primitive _ -> all_idents rem
     | Tstr_type decls -> all_idents rem
-    | Tstr_exception(id, _, decl) -> id :: all_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> id :: all_idents rem
+    | Tstr_exception decl -> decl.cd_id :: all_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> id :: all_idents rem
     | Tstr_recmodule decls ->
-      List.map (fun (id, _, _, _) -> id) decls @ all_idents rem
-    | Tstr_modtype(id, _, decl) -> all_idents rem
+      List.map (fun mb -> mb.mb_id) decls @ all_idents rem
+    | Tstr_modtype _ -> all_idents rem
     | Tstr_open _ -> all_idents rem
     | Tstr_class cl_list ->
       List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem
     | Tstr_class_type cl_list -> all_idents rem
-    | Tstr_include(modl, sg) -> bound_value_identifiers sg @ all_idents rem
-    | Tstr_module(id, _, { mod_desc = Tmod_structure str }) ->
-      id :: all_idents str.str_items @ all_idents rem
-    | Tstr_module(id, _, _) -> id :: all_idents rem
+    | Tstr_include(modl, sg, _) -> bound_value_identifiers sg @ all_idents rem
+    | Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}} ->
+        mb_id :: all_idents str.str_items @ all_idents rem
+    | Tstr_module mb -> mb.mb_id :: all_idents rem
+    | Tstr_attribute _ -> []
 
 
 (* A variant of transl_structure used to compile toplevel structure definitions
@@ -466,7 +472,7 @@ let transl_store_structure glob map prims str =
         lambda_unit
     | item :: rem ->
         match item.str_desc with
-  | Tstr_eval expr ->
+  | Tstr_eval (expr, _attrs) ->
       Lsequence(subst_lambda subst (transl_exp expr),
                 transl_store rootpath subst rem)
   | Tstr_value(rec_flag, pat_expr_list) ->
@@ -474,20 +480,21 @@ let transl_store_structure glob map prims str =
       let lam = transl_let rec_flag pat_expr_list (store_idents ids) in
       Lsequence(subst_lambda subst lam,
                 transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_primitive(id, _, descr) ->
+  | Tstr_primitive descr ->
       record_primitive descr.val_val;
       transl_store rootpath subst rem
   | Tstr_type(decls) ->
       transl_store rootpath subst rem
-  | Tstr_exception( id, _, decl) ->
-      let lam = transl_exception id (field_path rootpath id) decl in
+  | Tstr_exception decl ->
+      let id = decl.cd_id in
+      let lam = transl_exception (field_path rootpath id) decl in
       Lsequence(Llet(Strict, id, lam, store_ident id),
                 transl_store rootpath (add_ident false id subst) rem)
-  | Tstr_exn_rebind( id, _, path, _) ->
+  | Tstr_exn_rebind( id, _, path, _, _) ->
       let lam = subst_lambda subst (transl_path path) in
       Lsequence(Llet(Strict, id, lam, store_ident id),
                 transl_store rootpath (add_ident false id subst) rem)
-  | Tstr_module(id, _, { mod_desc = Tmod_structure str }) ->
+  | Tstr_module{mb_id=id; mb_expr={mod_desc = Tmod_structure str}} ->
     let lam = transl_store (field_path rootpath id) subst str.str_items in
       (* Careful: see next case *)
     let subst = !transl_store_subst in
@@ -500,7 +507,7 @@ let transl_store_structure glob map prims str =
                    Lsequence(store_ident id,
                              transl_store rootpath (add_ident true id subst)
                                           rem)))
-  | Tstr_module( id, _, modl) ->
+  | Tstr_module{mb_id=id; mb_expr=modl} ->
       let lam =
         transl_module Tcoerce_none (field_path rootpath id) modl in
       (* Careful: the module value stored in the global may be different
@@ -513,7 +520,7 @@ let transl_store_structure glob map prims str =
         Lsequence(store_ident id,
                   transl_store rootpath (add_ident true id subst) rem))
   | Tstr_recmodule bindings ->
-      let ids = List.map fst4 bindings in
+      let ids = List.map (fun mb -> mb.mb_id) bindings in
       compile_recmodule
         (fun id modl ->
           subst_lambda subst
@@ -522,10 +529,6 @@ let transl_store_structure glob map prims str =
         bindings
         (Lsequence(store_idents ids,
                    transl_store rootpath (add_idents true ids subst) rem))
-  | Tstr_modtype(id, _, decl) ->
-      transl_store rootpath subst rem
-  | Tstr_open _ ->
-      transl_store rootpath subst rem
   | Tstr_class cl_list ->
       let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
       let lam =
@@ -538,9 +541,7 @@ let transl_store_structure glob map prims str =
                 store_idents ids) in
       Lsequence(subst_lambda subst lam,
                 transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_class_type cl_list ->
-      transl_store rootpath subst rem
-  | Tstr_include(modl, sg) ->
+  | Tstr_include(modl, sg, _attrs) ->
       let ids = bound_value_identifiers sg in
       let mid = Ident.create "include" in
       let rec store_idents pos = function
@@ -551,6 +552,11 @@ let transl_store_structure glob map prims str =
       Llet(Strict, mid,
            subst_lambda subst (transl_module Tcoerce_none None modl),
            store_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_store rootpath subst rem
 
   and store_ident id =
     try
@@ -635,7 +641,7 @@ let transl_store_gen module_name ({ str_items = str }, restr) topl =
   let (map, prims, size) =
     build_ident_map restr (defined_idents str) (more_idents str) in
   let f = function
-    | [ { str_desc = Tstr_eval expr } ] when topl ->
+    | [ { str_desc = Tstr_eval (expr, _attrs) } ] when topl ->
         assert (size = 0);
         subst_lambda !transl_store_subst (transl_exp expr)
     | str -> transl_store_structure module_id map prims str in
@@ -671,13 +677,13 @@ let toplevel_name id =
 let toploop_getvalue id =
   Lapply(Lprim(Pfield toploop_getvalue_pos,
                  [Lprim(Pgetglobal toploop_ident, [])]),
-         [Lconst(Const_base(Const_string (toplevel_name id)))],
+         [Lconst(Const_base(Const_string (toplevel_name id, None)))],
          Location.none)
 
 let toploop_setvalue id lam =
   Lapply(Lprim(Pfield toploop_setvalue_pos,
                  [Lprim(Pgetglobal toploop_ident, [])]),
-         [Lconst(Const_base(Const_string (toplevel_name id))); lam],
+         [Lconst(Const_base(Const_string (toplevel_name id, None))); lam],
          Location.none)
 
 let toploop_setvalue_id id = toploop_setvalue id (Lvar id)
@@ -688,36 +694,28 @@ let close_toplevel_term lam =
 
 let transl_toplevel_item item =
   match item.str_desc with
-    Tstr_eval expr ->
+    Tstr_eval (expr, _attrs) ->
       transl_exp expr
   | Tstr_value(rec_flag, pat_expr_list) ->
       let idents = let_bound_idents pat_expr_list in
       transl_let rec_flag pat_expr_list
                  (make_sequence toploop_setvalue_id idents)
-  | Tstr_primitive(id, _, descr) ->
-      lambda_unit
-  | Tstr_type(decls) ->
-      lambda_unit
-  | Tstr_exception(id, _, decl) ->
-      toploop_setvalue id (transl_exception id None decl)
-  | Tstr_exn_rebind(id, _, path, _) ->
+  | Tstr_exception decl ->
+      toploop_setvalue decl.cd_id (transl_exception None decl)
+  | Tstr_exn_rebind(id, _, path, _, _) ->
       toploop_setvalue id (transl_path path)
-  | Tstr_module(id, _, modl) ->
+  | Tstr_module {mb_id=id; mb_expr=modl} ->
       (* we need to use the unique name for the module because of issues
          with "open" (PR#1672) *)
       set_toplevel_unique_name id;
       toploop_setvalue id
                         (transl_module Tcoerce_none (Some(Pident id)) modl)
   | Tstr_recmodule bindings ->
-      let idents = List.map fst4 bindings in
+      let idents = List.map (fun mb -> mb.mb_id) bindings in
       compile_recmodule
         (fun id modl -> transl_module Tcoerce_none (Some(Pident id)) modl)
         bindings
         (make_sequence toploop_setvalue_id idents)
-  | Tstr_modtype(id, _, decl) ->
-      lambda_unit
-  | Tstr_open _ ->
-      lambda_unit
   | Tstr_class cl_list ->
       (* we need to use unique names for the classes because there might
          be a value named identically *)
@@ -732,9 +730,7 @@ let transl_toplevel_item item =
               make_sequence
                 (fun (ci, _, _) -> toploop_setvalue_id ci.ci_id_class)
                 cl_list)
-  | Tstr_class_type cl_list ->
-      lambda_unit
-  | Tstr_include(modl, sg) ->
+  | Tstr_include(modl, sg, _attrs) ->
       let ids = bound_value_identifiers sg in
       let mid = Ident.create "include" in
       let rec set_idents pos = function
@@ -744,6 +740,13 @@ let transl_toplevel_item item =
           Lsequence(toploop_setvalue id (Lprim(Pfield pos, [Lvar mid])),
                     set_idents (pos + 1) ids) in
       Llet(Strict, mid, transl_module Tcoerce_none None modl, set_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      lambda_unit
 
 let transl_toplevel_item_and_close itm =
   close_toplevel_term (transl_label_init (transl_toplevel_item itm))
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 97fdeb5da..437c3d71e 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -86,7 +86,7 @@ let reset_labels () =
 
 (* Insert labels *)
 
-let string s = Lconst (Const_base (Const_string s))
+let string s = Lconst (Const_base (Const_string (s, None)))
 let int n = Lconst (Const_base (Const_int n))
 
 let prim_makearray =
diff --git a/camlp4/Camlp4/Camlp4Ast.partial.ml b/camlp4/Camlp4/Camlp4Ast.partial.ml
index d3869519a..6bd8ecd49 100644
--- a/camlp4/Camlp4/Camlp4Ast.partial.ml
+++ b/camlp4/Camlp4/Camlp4Ast.partial.ml
@@ -104,6 +104,7 @@
     | TyAmp of loc and ctyp and ctyp (* t & t *)
     | TyOfAmp of loc and ctyp and ctyp (* t of & t *)
     | TyPkg of loc and module_type (* (module S) *)
+    | TyAtt of loc and string and str_item and ctyp  (* .. [@attr] *)
     | TyAnt of loc and string (* $s$ *)
     ]
    and patt =
@@ -137,6 +138,7 @@
     | PaTyp of loc and ident (* #i *)
     | PaVrn of loc and string (* `s *)
     | PaLaz of loc and patt (* lazy p *)
+    | PaAtt of loc and string and str_item and patt  (* .. [@attr] *)
     | PaMod of loc and string (* (module M) *) ]
   and expr =
     [ ExNil of loc
@@ -205,7 +207,10 @@
       (* let f x (type t) y z = e *)
     | ExFUN of loc and string and expr
       (* (module ME : S) which is represented as (module (ME : S)) *)
-    | ExPkg of loc and module_expr ]
+    | ExPkg of loc and module_expr
+      (* e [@attr] *)
+    | ExAtt of loc and string and str_item and expr
+  ]
   and module_type =
     [ MtNil of loc
       (* i *) (* A.B.C *)
@@ -220,6 +225,7 @@
     | MtWit of loc and module_type and with_constr
       (* module type of m *)
     | MtOf of loc and module_expr
+    | MtAtt of loc and string and str_item and module_type  (* .. [@attr] *)
     | MtAnt of loc and string (* $s$ *) ]
   and sig_item =
     [ SgNil of loc
@@ -308,6 +314,7 @@
       (* (value e) *)
       (* (value e : S) which is represented as (value (e : S)) *)
     | MePkg of loc and expr
+    | MeAtt of loc and string and str_item and module_expr  (* .. [@attr] *)
     | MeAnt of loc and string (* $s$ *) ]
   and str_item =
     [ StNil of loc
@@ -355,6 +362,7 @@
       (* ct = ct *)
     | CtEq  of loc and class_type and class_type
       (* $s$ *)
+    | CtAtt of loc and string and str_item and class_type  (* .. [@attr] *)
     | CtAnt of loc and string ]
   and class_sig_item =
     [ CgNil of loc
@@ -390,6 +398,7 @@
       (* ce = ce *)
     | CeEq  of loc and class_expr and class_expr
       (* $s$ *)
+    | CeAtt of loc and string and str_item and class_expr  (* .. [@attr] *)
     | CeAnt of loc and string ]
   and class_str_item =
     [ CrNil of loc
diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml
index 7771ddfa6..e3add4b53 100644
--- a/camlp4/Camlp4/Printers/OCaml.ml
+++ b/camlp4/Camlp4/Printers/OCaml.ml
@@ -587,6 +587,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
            o#module_expr me o#module_type mt
     | <:expr< (module $me$) >> ->
         pp f "@[<hv0>@[<hv2>(module %a@])@]" o#module_expr me
+    | Ast.ExAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#expr e s o#str_item str
     | <:expr< $_$ $_$ >> | <:expr< $_$ . $_$ >> | <:expr< $_$ . ( $_$ ) >> |
       <:expr< $_$ . [ $_$ ] >> | <:expr< $_$ := $_$ >> |
       <:expr< $_$ # $_$ >> |
@@ -690,6 +692,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       <:patt< $_$ .. $_$ >> | <:patt< $_$, $_$ >> |
       <:patt< $_$; $_$ >> | <:patt< $_$ = $_$ >> | <:patt< lazy $_$ >> as p ->
           pp f "@[<1>(%a)@]" o#patt p
+    | Ast.PaAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#patt e s o#str_item str
     ];
 
     method patt_tycon f =
@@ -726,6 +730,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:ctyp< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i
     | <:ctyp< `$s$ >> -> pp f "`%a" o#var s
     | <:ctyp< $t1$ * $t2$ >> -> pp f "%a *@ %a" o#simple_ctyp t1 o#simple_ctyp t2
+    | Ast.TyAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#ctyp e s o#str_item str
     | <:ctyp<>> -> assert False
     | t -> pp f "@[<1>(%a)@]" o#ctyp t ];
 
@@ -904,6 +910,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:module_type< '$s$ >> -> pp f "'%a" o#var s
     | <:module_type< sig $sg$ end >> ->
           pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" o#sig_item sg
+    | Ast.MtAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#module_type e s o#str_item str
     | <:module_type< $mt$ with $wc$ >> ->
           pp f "@[<2>%a@ with@ %a@]" o#module_type mt o#with_constraint wc ];
 
@@ -950,6 +958,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
           pp f "@[<1>(%s %a :@ %a)@]" o#value_val o#expr e o#module_type mt
     | <:module_expr< (value $e$ ) >> ->
           pp f "@[<1>(%s %a)@]" o#value_val o#expr e
+    | Ast.MeAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#module_expr e s o#str_item str
     ];
 
     method class_expr f ce =
@@ -985,6 +995,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
             o#patt_class_expr_fun_args (p, ce2)
     | <:class_expr< $ce1$ = $ce2$ >> ->
           pp f "@[<2>%a =@]@ %a" o#class_expr ce1 o#class_expr ce2
+    | Ast.CeAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#class_expr e s o#str_item str
     | _ -> assert False ];
 
     method class_type f ct =
@@ -1012,6 +1024,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
           pp f "%a :@ %a" o#class_type ct1 o#class_type ct2
     | <:class_type< $ct1$ = $ct2$ >> ->
           pp f "%a =@ %a" o#class_type ct1 o#class_type ct2
+    | Ast.CtAtt _loc s str e ->
+        pp f "((%a)[@@%s %a])" o#class_type e s o#str_item str
     | _ -> assert False ];
 
     method class_sig_item f csg =
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast.mlast b/camlp4/Camlp4/Struct/Camlp4Ast.mlast
index 9c5a99752..8feaca0e1 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast.mlast
+++ b/camlp4/Camlp4/Struct/Camlp4Ast.mlast
@@ -122,6 +122,7 @@ module Make (Loc : Sig.Loc)
     | <:patt< ~ $_$ >> -> True
     | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p
     | <:patt< lazy $p$ >> -> is_irrefut_patt p
+    | Ast.PaAtt _loc _s _str p -> is_irrefut_patt p
     | <:patt< $id:_$ >> -> False (* here one need to know the arity of constructors *)
     | <:patt< (module $_$) >> -> True
     | <:patt< `$_$ >> | <:patt< $str:_$ >> | <:patt< $_$ .. $_$ >> |
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index c1468b961..8dab7d8d6 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -27,10 +27,6 @@ module Make (Ast : Sig.Camlp4Ast) = struct
   open Camlp4_import.Asttypes;
   open Ast;
 
-  value constructors_arity () =
-    debug ast2pt "constructors_arity: %b@." Camlp4_config.constructors_arity.val in
-    Camlp4_config.constructors_arity.val;
-
   value error loc str = Loc.raise loc (Failure str);
 
   value char_of_char_token loc s =
@@ -59,19 +55,18 @@ module Make (Ast : Sig.Camlp4Ast) = struct
 
   value with_loc txt loc = Camlp4_import.Location.mkloc txt (mkloc loc);
 
-  value mktyp loc d = {ptyp_desc = d; ptyp_loc = mkloc loc};
-  value mkpat loc d = {ppat_desc = d; ppat_loc = mkloc loc};
-  value mkghpat loc d = {ppat_desc = d; ppat_loc = mkghloc loc};
-  value mkexp loc d = {pexp_desc = d; pexp_loc = mkloc loc};
-  value mkmty loc d = {pmty_desc = d; pmty_loc = mkloc loc};
+  value mktyp loc d = {ptyp_desc = d; ptyp_loc = mkloc loc; ptyp_attributes = []};
+  value mkpat loc d = {ppat_desc = d; ppat_loc = mkloc loc; ppat_attributes = []};
+  value mkghpat loc d = {ppat_desc = d; ppat_loc = mkghloc loc; ppat_attributes = []};
+  value mkexp loc d = {pexp_desc = d; pexp_loc = mkloc loc; pexp_attributes = []};
+  value mkmty loc d = {pmty_desc = d; pmty_loc = mkloc loc; pmty_attributes = []};
   value mksig loc d = {psig_desc = d; psig_loc = mkloc loc};
-  value mkmod loc d = {pmod_desc = d; pmod_loc = mkloc loc};
+  value mkmod loc d = {pmod_desc = d; pmod_loc = mkloc loc; pmod_attributes = []};
   value mkstr loc d = {pstr_desc = d; pstr_loc = mkloc loc};
-  value mkfield loc d = {pfield_desc = d; pfield_loc = mkloc loc};
-  value mkcty loc d = {pcty_desc = d; pcty_loc = mkloc loc};
-  value mkcl loc d = {pcl_desc = d; pcl_loc = mkloc loc};
-  value mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; };
-  value mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; };
+  value mkcty loc d = {pcty_desc = d; pcty_loc = mkloc loc; pcty_attributes = []};
+  value mkcl loc d = {pcl_desc = d; pcl_loc = mkloc loc; pcl_attributes = []};
+  value mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; pcf_attributes = []};
+  value mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; pctf_attributes = []};
 
   value mkpolytype t =
     match t.ptyp_desc with
@@ -222,6 +217,11 @@ module Make (Ast : Sig.Camlp4Ast) = struct
   value predef_option loc =
     TyId (loc, IdAcc (loc, IdLid (loc, "*predef*"), IdLid (loc, "option")));
 
+  value attribute_fwd = ref (fun _ _ _ -> assert False);
+
+  value attribute loc s str =
+    !attribute_fwd loc s str;
+
   value rec ctyp =
     fun
     [ TyId loc i ->
@@ -239,7 +239,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | 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) [])
+        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))
@@ -247,14 +247,17 @@ module Make (Ast : Sig.Camlp4Ast) = struct
         let t1 = TyApp loc1 (predef_option loc1) t1 in
         mktyp loc (Ptyp_arrow ("?" ^ lab) (ctyp t1) (ctyp t2))
     | TyArr loc t1 t2 -> mktyp loc (Ptyp_arrow "" (ctyp t1) (ctyp t2))
-    | <:ctyp@loc< < $fl$ > >> -> mktyp loc (Ptyp_object (meth_list fl []))
+    | <:ctyp@loc< < $fl$ > >> -> mktyp loc (Ptyp_object (meth_list fl []) Closed)
     | <:ctyp@loc< < $fl$ .. > >> ->
-        mktyp loc (Ptyp_object (meth_list fl [mkfield loc Pfield_var]))
+        mktyp loc (Ptyp_object (meth_list fl []) Open)
     | TyCls loc id ->
-        mktyp loc (Ptyp_class (ident id) [] [])
+        mktyp loc (Ptyp_class (ident id) [])
     | <:ctyp@loc< (module $pt$) >> ->
         let (i, cs) = package_type pt in
         mktyp loc (Ptyp_package i cs)
+    | TyAtt loc s str e ->
+        let e = ctyp e in
+        {(e) with ptyp_attributes = e.ptyp_attributes @ [attribute loc s str]}
     | 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"
@@ -271,11 +274,11 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | TySem loc _ _ -> error loc "type1 ; type2 not allowed here"
     | <:ctyp@loc< ($t1$ * $t2$) >> ->
          mktyp loc (Ptyp_tuple (List.map ctyp (list_of_ctyp t1 (list_of_ctyp t2 []))))
-    | <:ctyp@loc< [ = $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) True None)
-    | <:ctyp@loc< [ > $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) False None)
-    | <:ctyp@loc< [ < $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) True (Some []))
+    | <:ctyp@loc< [ = $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Closed None)
+    | <:ctyp@loc< [ > $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Open None)
+    | <:ctyp@loc< [ < $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Closed (Some []))
     | <:ctyp@loc< [ < $t$ > $t'$ ] >> ->
-        mktyp loc (Ptyp_variant (row_field t) True (Some (name_tags t')))
+        mktyp loc (Ptyp_variant (row_field t) Closed (Some (name_tags t')))
     | TyAnt loc _ -> error loc "antiquotation not allowed here"
     | TyOfAmp _ _ _ |TyAmp _ _ _ |TySta _ _ _ |
       TyCom _ _ _ |TyVrn _ _ |TyQuM _ _ |TyQuP _ _ |TyDcl _ _ _ _ _ |
@@ -297,8 +300,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     match fl with
     [ <:ctyp<>> -> acc
     | <:ctyp< $t1$; $t2$ >> -> meth_list t1 (meth_list t2 acc)
-    | <:ctyp@loc< $lid:lab$ : $t$ >> ->
-        [mkfield loc (Pfield lab (mkpolytype (ctyp t))) :: acc]
+    | <:ctyp< $lid:lab$ : $t$ >> -> [(lab, mkpolytype (ctyp t)) :: acc]
     | _ -> assert False ]
 
   and package_type_constraints wc acc =
@@ -318,11 +320,11 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | mt -> error (loc_of_module_type mt) "unexpected package type" ]
   ;
 
-  value mktype loc tl cl tk tp tm =
-    let (params, variance) = List.split tl in
-    {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk;
+  value mktype loc name tl cl tk tp tm =
+    {ptype_name = name;
+     ptype_params = tl; ptype_cstrs = cl; ptype_kind = tk;
      ptype_private = tp; ptype_manifest = tm; ptype_loc = mkloc loc;
-     ptype_variance = variance}
+     ptype_attributes = []}
   ;
   value mkprivate' m = if m then Private else Public;
   value mkprivate = fun
@@ -332,36 +334,45 @@ module Make (Ast : Sig.Camlp4Ast) = struct
   value mktrecord =
     fun
     [ <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : mutable $t$ >> ->
-        (with_loc s sloc, Mutable, mkpolytype (ctyp t), mkloc loc)
+      {pld_name=with_loc s sloc;
+       pld_mutable=Mutable;
+       pld_type=mkpolytype (ctyp t);
+       pld_loc=mkloc loc;
+       pld_attributes=[];
+      }
     | <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : $t$ >> ->
-        (with_loc s sloc, Immutable, mkpolytype (ctyp t), mkloc loc)
+      {pld_name=with_loc s sloc;
+       pld_mutable=Immutable;
+       pld_type=mkpolytype (ctyp t);
+       pld_loc=mkloc loc;
+       pld_attributes=[];
+      }
     | _ -> assert False (*FIXME*) ];
   value mkvariant =
     fun
     [ <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ >> ->
-      (with_loc (conv_con s) sloc, [], None, mkloc loc)
+      {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
     | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ of $t$ >> ->
-      (with_loc (conv_con s) sloc, List.map ctyp (list_of_ctyp t []), None, mkloc loc)
+        {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
     | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : ($t$ -> $u$) >> ->
-      (with_loc (conv_con s) sloc, List.map ctyp (list_of_ctyp t []), Some (ctyp u), mkloc loc)
+        {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = Some (ctyp u); pcd_loc = mkloc loc; pcd_attributes = []}
     | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : $t$ >> ->
-      (with_loc (conv_con s) sloc, [], Some (ctyp t), mkloc loc)
-
+        {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = Some (ctyp t); pcd_loc = mkloc loc; pcd_attributes = []}
     | _ -> assert False (*FIXME*) ];
-  value rec type_decl tl cl loc m pflag =
+  value rec type_decl name tl cl loc m pflag =
     fun
     [ <:ctyp< $t1$ == $t2$ >> ->
-        type_decl tl cl loc (Some (ctyp t1)) pflag t2
+        type_decl name tl cl loc (Some (ctyp t1)) pflag t2
     | <:ctyp@_loc< private $t$ >> ->
         if pflag then
           error _loc "multiple private keyword used, use only one instead"
         else
-          type_decl tl cl loc m True t
+          type_decl name tl cl loc m True t
     | <:ctyp< { $t$ } >> ->
-        mktype loc tl cl
+        mktype loc name tl cl
           (Ptype_record (List.map mktrecord (list_of_ctyp t []))) (mkprivate' pflag) m
     | <:ctyp< [ $t$ ] >> ->
-        mktype loc tl cl
+        mktype loc name tl cl
           (Ptype_variant (List.map mkvariant (list_of_ctyp t []))) (mkprivate' pflag) m
     | t ->
         if m <> None then
@@ -371,12 +382,12 @@ module Make (Ast : Sig.Camlp4Ast) = struct
           [ <:ctyp<>> -> None
           | _ -> Some (ctyp t) ]
         in
-        mktype loc tl cl Ptype_abstract (mkprivate' pflag) m ]
+        mktype loc name tl cl Ptype_abstract (mkprivate' pflag) m ]
   ;
 
-  value type_decl tl cl t loc = type_decl tl cl loc None False t;
+  value type_decl name tl cl t loc = type_decl name tl cl loc None False t;
 
-  value mkvalue_desc loc t p = {pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc};
+  value mkvalue_desc loc name t p = {pval_name = name; pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc; pval_attributes = []};
 
   value rec list_of_meta_list =
     fun
@@ -404,28 +415,28 @@ module Make (Ast : Sig.Camlp4Ast) = struct
   value rec type_parameters t acc =
     match t with
     [ <:ctyp< $t1$ $t2$ >> -> type_parameters t1 (type_parameters t2 acc)
-    | <:ctyp< +'$s$ >> -> [(s, (True, False)) :: acc]
-    | <:ctyp< -'$s$ >> -> [(s, (False, True)) :: acc]
-    | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc]
+    | <:ctyp< +'$s$ >> -> [(s, Covariant) :: acc]
+    | <:ctyp< -'$s$ >> -> [(s, Contravariant) :: acc]
+    | <:ctyp< '$s$ >> -> [(s, Invariant) :: acc]
     | _ -> assert False ];
 
   value rec optional_type_parameters t acc =
     match t with
     [ <:ctyp< $t1$ $t2$ >> -> optional_type_parameters t1 (optional_type_parameters t2 acc)
-    | <:ctyp@loc< +'$s$ >> -> [(Some (with_loc s loc), (True, False)) :: acc]
-    | Ast.TyAnP _loc  -> [(None, (True, False)) :: acc]
-    | <:ctyp@loc< -'$s$ >> -> [(Some (with_loc s loc), (False, True)) :: acc]
-    | Ast.TyAnM _loc -> [(None, (False, True)) :: acc]
-    | <:ctyp@loc< '$s$ >> -> [(Some (with_loc s loc), (False, False)) :: acc]
-    | Ast.TyAny _loc -> [(None, (False, False)) :: acc]
+    | <:ctyp@loc< +'$s$ >> -> [(Some (with_loc s loc), Covariant) :: acc]
+    | Ast.TyAnP _loc  -> [(None, Covariant) :: acc]
+    | <:ctyp@loc< -'$s$ >> -> [(Some (with_loc s loc), Contravariant) :: acc]
+    | Ast.TyAnM _loc -> [(None, Contravariant) :: acc]
+    | <:ctyp@loc< '$s$ >> -> [(Some (with_loc s loc), Invariant) :: acc]
+    | Ast.TyAny _loc -> [(None, Invariant) :: acc]
     | _ -> assert False ];
 
   value rec class_parameters t acc =
     match t with
     [ <:ctyp< $t1$, $t2$ >> -> class_parameters t1 (class_parameters t2 acc)
-    | <:ctyp@loc< +'$s$ >> -> [(with_loc s loc, (True, False)) :: acc]
-    | <:ctyp@loc< -'$s$ >> -> [(with_loc s loc, (False, True)) :: acc]
-    | <:ctyp@loc< '$s$ >> -> [(with_loc s loc, (False, False)) :: acc]
+    | <:ctyp@loc< +'$s$ >> -> [(with_loc s loc, Covariant) :: acc]
+    | <:ctyp@loc< -'$s$ >> -> [(with_loc s loc, Contravariant) :: acc]
+    | <:ctyp@loc< '$s$ >> -> [(with_loc s loc, Invariant) :: acc]
     | _ -> assert False ];
 
   value rec type_parameters_and_type_name t acc =
@@ -438,26 +449,33 @@ module Make (Ast : Sig.Camlp4Ast) = struct
 
   value mkwithtyp pwith_type loc id_tpl ct =
     let (id, tpl) = type_parameters_and_type_name id_tpl [] in
-    let (params, variance) = List.split tpl in
     let (kind, priv, ct) = opt_private_ctyp ct in
-    (id, pwith_type
-      {ptype_params = params; ptype_cstrs = [];
+    pwith_type id
+      { ptype_name = Camlp4_import.Location.mkloc (Camlp4_import.Longident.last id.txt) id.loc;
+        ptype_params = tpl; ptype_cstrs = [];
         ptype_kind = kind;
         ptype_private = priv;
         ptype_manifest = Some ct;
-        ptype_loc = mkloc loc; ptype_variance = variance});
+        ptype_loc = mkloc loc;
+        ptype_attributes = [];
+      };
 
   value rec mkwithc wc acc =
     match wc with
     [ <:with_constr<>> -> acc
     | <:with_constr@loc< type $id_tpl$ = $ct$ >> ->
-        [mkwithtyp (fun x -> Pwith_type x) loc id_tpl ct :: acc]
+        [mkwithtyp (fun lid x -> Pwith_type lid x) loc id_tpl ct :: acc]
     | <:with_constr< module $i1$ = $i2$ >> ->
-        [(long_uident i1, Pwith_module (long_uident i2)) :: acc]
+        [(Pwith_module (long_uident i1) (long_uident i2)) :: acc]
     | <:with_constr@loc< type $id_tpl$ := $ct$ >> ->
-        [mkwithtyp (fun x -> Pwith_typesubst x) loc id_tpl ct :: acc]
-    | <:with_constr< module $i1$ := $i2$ >> (*WcMoS _ i1 i2*) ->
-        [(long_uident i1, Pwith_modsubst (long_uident i2)) :: acc]
+        [mkwithtyp (fun _ x -> Pwith_typesubst x) loc id_tpl ct :: acc]
+    | <:with_constr@loc< module $i1$ := $i2$ >> (*WcMoS _ i1 i2*) ->
+        match long_uident i1 with
+        [ {txt=Lident s; loc} ->
+          [(Pwith_modsubst {txt=s;loc} (long_uident i2)) ::
+           acc]
+        | _ -> error loc "bad 'with module :=' constraint"
+        ]
     | <:with_constr< $wc1$ and $wc2$ >> -> mkwithc wc1 (mkwithc wc2 acc)
     | <:with_constr@loc< $anti:_$ >> ->
          error loc "bad with constraint (antiquotation)" ];
@@ -490,8 +508,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     [ <:patt@loc< $id:(<:ident@sloc< $lid:s$ >>)$ >> ->
       mkpat loc (Ppat_var (with_loc s sloc))
     | <:patt@loc< $id:i$ >> ->
-        let p = Ppat_construct (long_uident ~conv_con i)
-                  None (constructors_arity ())
+        let p = Ppat_construct (long_uident ~conv_con i) None
         in mkpat loc p
     | PaAli loc p1 p2 ->
         let (p, i) =
@@ -505,26 +522,20 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | PaAny loc -> mkpat loc Ppat_any
     | <:patt@loc< $id:(<:ident@sloc< $uid:s$ >>)$ ($tup:<:patt@loc_any< _ >>$) >> ->
         mkpat loc (Ppat_construct (lident_with_loc (conv_con s) sloc)
-              (Some (mkpat loc_any Ppat_any)) False)
+              (Some (mkpat loc_any Ppat_any)))
     | PaApp loc _ _ as f ->
         let (f, al) = patt_fa [] f in
         let al = List.map patt al in
         match (patt f).ppat_desc with
-        [ Ppat_construct li None _ ->
-            if constructors_arity () then
-              mkpat loc (Ppat_construct li (Some (mkpat loc (Ppat_tuple al))) True)
-            else
+        [ Ppat_construct li None ->
               let a =
                 match al with
                 [ [a] -> a
                 | _ -> mkpat loc (Ppat_tuple al) ]
               in
-              mkpat loc (Ppat_construct li (Some a) False)
+              mkpat loc (Ppat_construct li (Some a))
         | Ppat_variant s None ->
             let a =
-              if constructors_arity () then
-                mkpat loc (Ppat_tuple al)
-              else
                 match al with
                 [ [a] -> a
                 | _ -> mkpat loc (Ppat_tuple al) ]
@@ -569,7 +580,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
         let is_closed = if wildcards = [] then Closed else Open in
         mkpat loc (Ppat_record (List.map mklabpat ps, is_closed))
     | PaStr loc s ->
-        mkpat loc (Ppat_constant (Const_string (string_of_string_token loc s)))
+        mkpat loc (Ppat_constant (Const_string (string_of_string_token loc s) None))
     | <:patt@loc< ($p1$, $p2$) >> ->
          mkpat loc (Ppat_tuple
            (List.map patt (list_of_patt p1 (list_of_patt p2 []))))
@@ -579,6 +590,9 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | PaVrn loc s -> mkpat loc (Ppat_variant (conv_con s) None)
     | PaLaz loc p -> mkpat loc (Ppat_lazy (patt p))
     | PaMod loc m -> mkpat loc (Ppat_unpack (with_loc m loc))
+    | PaAtt loc s str e ->
+        let e = patt e in
+        {(e) with ppat_attributes = e.ppat_attributes @ [attribute loc s str]}
     | PaEq _ _ _ | PaSem _ _ _ | PaCom _ _ _ | PaNil _ as p ->
         error (loc_of_patt p) "invalid pattern" ]
   and mklabpat =
@@ -644,10 +658,10 @@ value varify_constructors var_names =
           Ptyp_var ("&" ^ s)
       | Ptyp_constr longident lst ->
           Ptyp_constr longident (List.map loop lst)
-      | Ptyp_object lst ->
-          Ptyp_object (List.map loop_core_field lst)
-      | Ptyp_class longident lst lbl_list ->
-          Ptyp_class (longident, List.map loop lst, lbl_list)
+      | Ptyp_object (lst, o) ->
+          Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+      | Ptyp_class longident lst ->
+          Ptyp_class (longident, List.map loop lst)
       | Ptyp_alias core_type string ->
           Ptyp_alias(loop core_type, string)
       | Ptyp_variant row_field_list flag lbl_lst_option ->
@@ -656,18 +670,11 @@ value varify_constructors var_names =
           Ptyp_poly(string_lst, loop core_type)
       | Ptyp_package longident lst ->
           Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+      | Ptyp_extension x ->
+          Ptyp_extension x
 ]
     in
     {(t) with ptyp_desc = desc}
-  and loop_core_field t =
-    let desc =
-      match t.pfield_desc with
-      [ Pfield(n,typ) ->
-          Pfield(n,loop typ)
-      | Pfield_var ->
-          Pfield_var]
-    in
-    { (t) with pfield_desc=desc}
   and loop_row_field x  =
     match x with
       [ Rtag(label,flag,lst) ->
@@ -688,8 +695,7 @@ value varify_constructors var_names =
         let (e, l) =
           match sep_expr_acc [] e with
           [ [(loc, ml, <:expr@sloc< $uid:s$ >>) :: l] ->
-              let ca = constructors_arity () in
-              (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None ca), l)
+              (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None), l)
           | [(loc, ml, <:expr@sloc< $lid:s$ >>) :: l] ->
               (mkexp loc (Pexp_ident (mkli sloc s ml)), l)
           | [(_, [], e) :: l] -> (expr e, l)
@@ -711,23 +717,17 @@ value varify_constructors var_names =
         let (f, al) = expr_fa [] f in
         let al = List.map label_expr al in
         match (expr f).pexp_desc with
-        [ Pexp_construct li None _ ->
+        [ Pexp_construct li None ->
             let al = List.map snd al in
-            if constructors_arity () then
-              mkexp loc (Pexp_construct li (Some (mkexp loc (Pexp_tuple al))) True)
-            else
               let a =
                 match al with
                 [ [a] -> a
                 | _ -> mkexp loc (Pexp_tuple al) ]
               in
-              mkexp loc (Pexp_construct li (Some a) False)
+              mkexp loc (Pexp_construct li (Some a))
         | Pexp_variant s None ->
             let al = List.map snd al in
             let a =
-              if constructors_arity () then
-                mkexp loc (Pexp_tuple al)
-              else
                 match al with
                 [ [a] -> a
                 | _ -> mkexp loc (Pexp_tuple al) ]
@@ -738,7 +738,8 @@ value varify_constructors var_names =
           (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "Array" "get")))
             [("", expr e1); ("", expr e2)])
     | ExArr loc e -> mkexp loc (Pexp_array (List.map expr (list_of_expr e [])))
-    | ExAsf loc -> mkexp loc Pexp_assertfalse
+    | ExAsf loc -> 
+        mkexp loc (Pexp_assert (mkexp loc (Pexp_construct {txt=Lident "false"; loc=mkloc loc} None)))
     | ExAss loc e v ->
         let e =
           match e with
@@ -768,24 +769,20 @@ value varify_constructors var_names =
           match t1 with
           [ <:ctyp<>> -> None
           | t -> Some (ctyp t) ] in
-        mkexp loc (Pexp_constraint (expr e) t1 (Some (ctyp t2)))
+        mkexp loc (Pexp_coerce (expr e) t1 (ctyp t2))
     | ExFlo loc s -> mkexp loc (Pexp_constant (Const_float (remove_underscores s)))
     | ExFor loc i e1 e2 df el ->
         let e3 = ExSeq loc el in
         mkexp loc (Pexp_for (with_loc i loc) (expr e1) (expr e2) (mkdirection df) (expr e3))
     | <:expr@loc< fun [ $PaLab _ lab po$ when $w$ -> $e$ ] >> ->
-        mkexp loc
-          (Pexp_function lab None
-            [(patt_of_lab loc lab po, when_expr e w)])
+        mkfun loc lab None (patt_of_lab loc lab po) e w
     | <:expr@loc< fun [ $PaOlbi _ lab p e1$ when $w$ -> $e2$ ] >> ->
         let lab = paolab lab p in
-        mkexp loc
-          (Pexp_function ("?" ^ lab) (Some (expr e1)) [(patt p, when_expr e2 w)])
+        mkfun loc ("?" ^ lab) (Some (expr e1)) (patt p) e2 w
     | <:expr@loc< fun [ $PaOlb _ lab p$ when $w$ -> $e$ ] >> ->
         let lab = paolab lab p in
-        mkexp loc
-          (Pexp_function ("?" ^ lab) None [(patt_of_lab loc lab p, when_expr e w)])
-    | ExFun loc a -> mkexp loc (Pexp_function "" None (match_case a []))
+        mkfun loc ("?" ^ lab) None (patt_of_lab loc lab p) e w
+    | ExFun loc a -> mkexp loc (Pexp_function (match_case a []))
     | ExIfe loc e1 e2 e3 ->
         mkexp loc (Pexp_ifthenelse (expr e1) (expr e2) (Some (expr e3)))
     | ExInt loc s ->
@@ -818,7 +815,7 @@ value varify_constructors var_names =
           | p -> p ]
         in
         let cil = class_str_item cfl [] in
-        mkexp loc (Pexp_object { pcstr_pat = patt p; pcstr_fields = cil })
+        mkexp loc (Pexp_object { pcstr_self = patt p; pcstr_fields = cil })
     | ExOlb loc _ _ -> error loc "labeled expression not allowed here"
     | ExOvr loc iel -> mkexp loc (Pexp_override (mkideexp iel []))
     | ExRec loc lel eo ->
@@ -846,19 +843,18 @@ value varify_constructors var_names =
           (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "String" "get")))
             [("", expr e1); ("", expr e2)])
     | ExStr loc s ->
-        mkexp loc (Pexp_constant (Const_string (string_of_string_token loc s)))
+        mkexp loc (Pexp_constant (Const_string (string_of_string_token loc s) None))
     | ExTry loc e a -> mkexp loc (Pexp_try (expr e) (match_case a []))
     | <:expr@loc< ($e1$, $e2$) >> ->
          mkexp loc (Pexp_tuple (List.map expr (list_of_expr e1 (list_of_expr e2 []))))
     | <:expr@loc< ($tup:_$) >> -> error loc "singleton tuple"
-    | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (Some (ctyp t)) None)
+    | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (ctyp t))
     | <:expr@loc< () >> ->
-        mkexp loc (Pexp_construct (lident_with_loc "()" loc) None True)
+        mkexp loc (Pexp_construct (lident_with_loc "()" loc) None)
     | <:expr@loc< $lid:s$ >> ->
         mkexp loc (Pexp_ident (lident_with_loc s loc))
     | <:expr@loc< $uid:s$ >> ->
-        (* let ca = constructors_arity () in *)
-        mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None True)
+        mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None)
     | ExVrn loc s -> mkexp loc (Pexp_variant (conv_con s) None)
     | ExWhi loc e1 el ->
         let e2 = ExSeq loc el in
@@ -868,7 +864,7 @@ value varify_constructors var_names =
         mkexp loc (Pexp_open fresh (long_uident i) (expr e))
     | <:expr@loc< (module $me$ : $pt$) >> ->
         mkexp loc (Pexp_constraint (mkexp loc (Pexp_pack (module_expr me)),
-                    Some (mktyp loc (Ptyp_package (package_type pt))), None))
+                    mktyp loc (Ptyp_package (package_type pt))))
     | <:expr@loc< (module $me$) >> ->
         mkexp loc (Pexp_pack (module_expr me))
     | ExFUN loc i e ->
@@ -876,6 +872,9 @@ value varify_constructors var_names =
     | <:expr@loc< $_$,$_$ >> -> error loc "expr, expr: not allowed here"
     | <:expr@loc< $_$;$_$ >> ->
         error loc "expr; expr: not allowed here, use do {...} or [|...|] to surround them"
+    | ExAtt loc s str e ->
+        let e = expr e in
+        {(e) with pexp_attributes = e.pexp_attributes @ [attribute loc s str]}
     | ExId _ _ | ExNil _ as e -> error (loc_of_expr e) "invalid expr" ]
   and patt_of_lab _loc lab =
     fun
@@ -907,7 +906,7 @@ value varify_constructors var_names =
       let ty' = varify_constructors vars (ctyp ty) in
       let mkexp = mkexp _loc in
       let mkpat = mkpat _loc in
-      let e = mkexp (Pexp_constraint (expr e) (Some (ctyp ty)) None) in
+      let e = mkexp (Pexp_constraint (expr e) (ctyp ty)) in
       let rec mk_newtypes x =
         match x with
           [ [newtype :: []] -> mkexp (Pexp_newtype(newtype, e))
@@ -920,23 +919,34 @@ value varify_constructors var_names =
                                 mktyp _loc (Ptyp_poly ampersand_vars ty')))
       in
       let e = mk_newtypes vars in
-      [( pat, e) :: acc]
+      [{pvb_pat=pat; pvb_expr=e; pvb_attributes=[]} :: acc]
     | <:binding@_loc< $p$ = ($e$ : ! $vs$ . $ty$) >> ->
-        [(patt <:patt< ($p$ : ! $vs$ . $ty$ ) >>, expr e) :: acc]
-    | <:binding< $p$ = $e$ >> -> [(patt p, expr e) :: acc]
+        [{pvb_pat=patt <:patt< ($p$ : ! $vs$ . $ty$ ) >>;
+          pvb_expr=expr e;
+          pvb_attributes=[]} :: acc]
+    | <:binding< $p$ = $e$ >> -> [{pvb_pat=patt p; pvb_expr=expr e; pvb_attributes=[]} :: acc]
     | <:binding<>> -> acc
     | _ -> assert False ]
   and match_case x acc =
     match x with
     [ <:match_case< $x$ | $y$ >> -> match_case x (match_case y acc)
     | <:match_case< $pat:p$ when $w$ -> $e$ >> ->
-        [(patt p, when_expr e w) :: acc]
+        [when_expr (patt p) e w :: acc]
     | <:match_case<>> -> acc
     | _ -> assert False ]
-  and when_expr e w =
-    match w with
-    [ <:expr<>> -> expr e
-    | w -> mkexp (loc_of_expr w) (Pexp_when (expr w) (expr e)) ]
+  and when_expr p e w =
+    let g = match w with
+    [ <:expr<>> -> None
+    | g -> Some (expr g) ]
+    in
+    {pc_lhs = p; pc_guard = g; pc_rhs = expr e}
+  and mkfun loc lab def p e w =
+     let () =
+       match w with
+         [ <:expr<>> -> ()
+       | _ -> assert False ]
+     in
+     mkexp loc (Pexp_fun lab def p (expr e))
   and mklabexp x acc =
     match x with
     [ <:rec_binding< $x$; $y$ >> ->
@@ -962,8 +972,7 @@ value varify_constructors var_names =
               (ctyp t1, ctyp t2, mkloc loc))
             cl
         in
-        [(with_loc c cloc,
-          type_decl (List.fold_right optional_type_parameters tl []) cl td cloc) :: acc]
+        [type_decl (with_loc c cloc) (List.fold_right optional_type_parameters tl []) cl td cloc :: acc]
     | _ -> assert False ]
   and module_type =
     fun
@@ -978,6 +987,9 @@ value varify_constructors var_names =
         mkmty loc (Pmty_with (module_type mt) (mkwithc wc []))
     | <:module_type@loc< module type of $me$ >> ->
         mkmty loc (Pmty_typeof (module_expr me))
+    | MtAtt loc s str e ->
+        let e = module_type e in
+        {(e) with pmty_attributes = e.pmty_attributes @ [attribute loc s str]}
     | <:module_type< $anti:_$ >> -> assert False ]
   and sig_item s l =
     match s with
@@ -991,41 +1003,46 @@ value varify_constructors var_names =
     | <:sig_item< $sg1$; $sg2$ >> -> sig_item sg1 (sig_item sg2 l)
     | SgDir _ _ _ -> l
     | <:sig_item@loc< exception $uid:s$ >> ->
-        [mksig loc (Psig_exception (with_loc (conv_con s) loc) []) :: l]
+        [mksig loc (Psig_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=[]; pcd_attributes=[]; pcd_res=None; pcd_loc=mkloc loc}) :: l]
     | <:sig_item@loc< exception $uid:s$ of $t$ >> ->
-        [mksig loc (Psig_exception (with_loc (conv_con s) loc)
-                                   (List.map ctyp (list_of_ctyp t []))) :: l]
+        [mksig loc (Psig_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=List.map ctyp (list_of_ctyp t []); pcd_attributes=[]; pcd_res=None; pcd_loc=mkloc loc}) :: l]
     | SgExc _ _ -> assert False (*FIXME*)
-    | SgExt loc n t sl -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t (list_of_meta_list sl))) :: l]
-    | SgInc loc mt -> [mksig loc (Psig_include (module_type mt)) :: l]
-    | SgMod loc n mt -> [mksig loc (Psig_module (with_loc n loc) (module_type mt)) :: l]
+    | SgExt loc n t sl -> [mksig loc (Psig_value (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl))) :: l]
+    | SgInc loc mt -> [mksig loc (Psig_include (module_type mt) []) :: l]
+    | SgMod loc n mt -> [mksig loc (Psig_module {pmd_name=with_loc n loc; pmd_type=module_type mt; pmd_attributes=[]}) :: l]
     | SgRecMod loc mb ->
         [mksig loc (Psig_recmodule (module_sig_binding mb [])) :: l]
     | SgMty loc n mt ->
         let si =
           match mt with
-          [ MtQuo _ _ -> Pmodtype_abstract
-          | _ -> Pmodtype_manifest (module_type mt) ]
+          [ MtQuo _ _ -> None
+          | _ -> Some (module_type mt) ]
         in
-        [mksig loc (Psig_modtype (with_loc n loc) si) :: l]
+        [mksig loc (Psig_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]}) :: l]
     | SgOpn loc id ->
-        [mksig loc (Psig_open Fresh (long_uident id)) :: l]
+        [mksig loc (Psig_open Fresh (long_uident id) []) :: l]
     | SgTyp loc tdl -> [mksig loc (Psig_type (mktype_decl tdl [])) :: l]
-    | SgVal loc n t -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t [])) :: l]
+    | SgVal loc n t -> [mksig loc (Psig_value (mkvalue_desc loc (with_loc n loc) t [])) :: l]
     | <:sig_item@loc< $anti:_$ >> -> error loc "antiquotation in sig_item" ]
   and module_sig_binding x acc =
     match x with
     [ <:module_binding< $x$ and $y$ >> ->
         module_sig_binding x (module_sig_binding y acc)
     | <:module_binding@loc< $s$ : $mt$ >> ->
-        [(with_loc s loc, module_type mt) :: acc]
+        [{pmd_name=with_loc s loc; pmd_type=module_type mt; pmd_attributes=[]} :: acc]
     | _ -> assert False ]
   and module_str_binding x acc =
     match x with
     [ <:module_binding< $x$ and $y$ >> ->
         module_str_binding x (module_str_binding y acc)
     | <:module_binding@loc< $s$ : $mt$ = $me$ >> ->
-        [(with_loc s loc, module_type mt, module_expr me) :: acc]
+        [{pmb_name=with_loc s loc;
+          pmb_expr=
+          {pmod_loc=Camlp4_import.Location.none;
+           pmod_desc=Pmod_constraint(module_expr me,module_type mt);
+           pmod_attributes=[];
+          };
+          pmb_attributes=[]} :: acc]
     | _ -> assert False ]
   and module_expr =
     fun
@@ -1042,10 +1059,12 @@ value varify_constructors var_names =
     | <:module_expr@loc< (value $e$ : $pt$) >> ->
         mkmod loc (Pmod_unpack (
                    mkexp loc (Pexp_constraint (expr e,
-                              Some (mktyp loc (Ptyp_package (package_type pt))),
-                              None))))
+                              mktyp loc (Ptyp_package (package_type pt))))))
     | <:module_expr@loc< (value $e$) >> ->
         mkmod loc (Pmod_unpack (expr e))
+    | MeAtt loc s str e ->
+        let e = module_expr e in
+        {(e) with pmod_attributes = e.pmod_attributes @ [attribute loc s str]}
     | <:module_expr@loc< $anti:_$ >> -> error loc "antiquotation in module_expr" ]
   and str_item s l =
     match s with
@@ -1059,25 +1078,30 @@ value varify_constructors var_names =
     | <:str_item< $st1$; $st2$ >> -> str_item st1 (str_item st2 l)
     | StDir _ _ _ -> l
     | <:str_item@loc< exception $uid:s$ >> ->
-        [mkstr loc (Pstr_exception (with_loc (conv_con s) loc) []) :: l ]
+        [mkstr loc (Pstr_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=[]; pcd_attributes=[]; pcd_res=None; pcd_loc=mkloc loc}) :: l ]
     | <:str_item@loc< exception $uid:s$ of $t$ >> ->
-        [mkstr loc (Pstr_exception (with_loc (conv_con s) loc)
-                      (List.map ctyp (list_of_ctyp t []))) :: l ]
+        [mkstr loc (Pstr_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=List.map ctyp (list_of_ctyp t []);pcd_attributes=[]; pcd_res=None; pcd_loc=mkloc loc}) :: l ]
     | <:str_item@loc< exception $uid:s$ = $i$ >> ->
-        [mkstr loc (Pstr_exn_rebind (with_loc (conv_con s) loc) (long_uident ~conv_con i)) :: l ]
+        [mkstr loc (Pstr_exn_rebind (with_loc (conv_con s) loc) (long_uident ~conv_con i) []) :: l ]
     | <:str_item@loc< exception $uid:_$ of $_$ = $_$ >> ->
         error loc "type in exception alias"
     | StExc _ _ _ -> assert False (*FIXME*)
-    | StExp loc e -> [mkstr loc (Pstr_eval (expr e)) :: l]
-    | StExt loc n t sl -> [mkstr loc (Pstr_primitive (with_loc n loc) (mkvalue_desc loc t (list_of_meta_list sl))) :: l]
-    | StInc loc me -> [mkstr loc (Pstr_include (module_expr me)) :: l]
-    | StMod loc n me -> [mkstr loc (Pstr_module (with_loc n loc) (module_expr me)) :: l]
+    | StExp loc e -> [mkstr loc (Pstr_eval (expr e) []) :: l]
+    | StExt loc n t sl -> [mkstr loc (Pstr_primitive (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl))) :: l]
+    | StInc loc me -> [mkstr loc (Pstr_include (module_expr me, [])) :: l]
+    | StMod loc n me -> [mkstr loc (Pstr_module {pmb_name=with_loc n loc;pmb_expr=module_expr me;pmb_attributes=[]}) :: l]
     | StRecMod loc mb ->
         [mkstr loc (Pstr_recmodule (module_str_binding mb [])) :: l]
-    | StMty loc n mt -> [mkstr loc (Pstr_modtype (with_loc n loc) (module_type mt)) :: l]
+    | StMty loc n mt ->
+        let si =
+          match mt with
+          [ MtQuo _ _ -> None
+          | _ -> Some (module_type mt) ]
+        in
+        [mkstr loc (Pstr_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]}) :: l]
     | StOpn loc ov id ->
         let fresh = override_flag loc ov in
-        [mkstr loc (Pstr_open fresh (long_uident id)) :: l]
+        [mkstr loc (Pstr_open fresh (long_uident id) []) :: l]
     | StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l]
     | StVal loc rf bi ->
         [mkstr loc (Pstr_value (mkrf rf) (binding bi [])) :: l]
@@ -1088,11 +1112,11 @@ value varify_constructors var_names =
         mkcty loc
           (Pcty_constr (long_class_ident id) (List.map ctyp (list_of_opt_ctyp tl [])))
     | CtFun loc (TyLab _ lab t) ct ->
-        mkcty loc (Pcty_fun lab (ctyp t) (class_type ct))
+        mkcty loc (Pcty_arrow lab (ctyp t) (class_type ct))
     | CtFun loc (TyOlb loc1 lab t) ct ->
         let t = TyApp loc1 (predef_option loc1) t in
-        mkcty loc (Pcty_fun ("?" ^ lab) (ctyp t) (class_type ct))
-    | CtFun loc t ct -> mkcty loc (Pcty_fun "" (ctyp t) (class_type ct))
+        mkcty loc (Pcty_arrow ("?" ^ lab) (ctyp t) (class_type ct))
+    | CtFun loc t ct -> mkcty loc (Pcty_arrow "" (ctyp t) (class_type ct))
     | CtSig loc t_o ctfl ->
         let t =
           match t_o with
@@ -1103,8 +1127,10 @@ value varify_constructors var_names =
         mkcty loc (Pcty_signature {
           pcsig_self = ctyp t;
           pcsig_fields = cil;
-          pcsig_loc = mkloc loc;
         })
+    | CtAtt loc s str e ->
+        let e = class_type e in
+        {(e) with pcty_attributes = e.pcty_attributes @ [attribute loc s str]}
     | CtCon loc _ _ _ ->
         error loc "invalid virtual class inside a class type"
     | CtAnt _ _ | CtEq _ _ _ | CtCol _ _ _ | CtAnd _ _ _ | CtNil _ ->
@@ -1113,48 +1139,50 @@ value varify_constructors var_names =
   and class_info_class_expr ci =
     match ci with
     [ CeEq _ (CeCon loc vir (IdLid nloc name) params) ce ->
-      let (loc_params, (params, variance)) =
+      let params =
         match params with
-        [ <:ctyp<>> -> (loc, ([], []))
-        | t -> (loc_of_ctyp t, List.split (class_parameters t [])) ]
+        [ <:ctyp<>> -> []
+        | t -> class_parameters t [] ]
       in
       {pci_virt = mkvirtual vir;
-       pci_params = (params, mkloc loc_params);
+       pci_params = params;
        pci_name = with_loc name nloc;
        pci_expr = class_expr ce;
        pci_loc = mkloc loc;
-       pci_variance = variance}
+       pci_attributes = []
+      }
     | ce -> error (loc_of_class_expr ce) "bad class definition" ]
   and class_info_class_type ci =
     match ci with
     [ CtEq _ (CtCon loc vir (IdLid nloc name) params) ct |
       CtCol _ (CtCon loc vir (IdLid nloc name) params) ct ->
-      let (loc_params, (params, variance)) =
+      let params =
         match params with
-        [ <:ctyp<>> -> (loc, ([], []))
-        | t -> (loc_of_ctyp t, List.split (class_parameters t [])) ]
+        [ <:ctyp<>> -> []
+        | t -> class_parameters t [] ]
       in
       {pci_virt = mkvirtual vir;
-       pci_params = (params, mkloc loc_params);
+       pci_params = params;
        pci_name = with_loc name nloc;
        pci_expr = class_type ct;
-       pci_loc = mkloc loc;
-       pci_variance = variance}
+       pci_attributes = [];
+       pci_loc = mkloc loc
+      }
     | ct -> error (loc_of_class_type ct)
               "bad class/class type declaration/definition" ]
   and class_sig_item c l =
     match c with
     [ <:class_sig_item<>> -> l
-    | CgCtr loc t1 t2 -> [mkctf loc (Pctf_cstr (ctyp t1, ctyp t2)) :: l]
+    | CgCtr loc t1 t2 -> [mkctf loc (Pctf_constraint (ctyp t1, ctyp t2)) :: l]
     | <:class_sig_item< $csg1$; $csg2$ >> ->
         class_sig_item csg1 (class_sig_item csg2 l)
-    | CgInh loc ct -> [mkctf loc (Pctf_inher (class_type ct)) :: l]
+    | CgInh loc ct -> [mkctf loc (Pctf_inherit (class_type ct)) :: l]
     | CgMth loc s pf t ->
-        [mkctf loc (Pctf_meth (s, mkprivate pf, mkpolytype (ctyp t))) :: l]
+        [mkctf loc (Pctf_method (s, mkprivate pf, Concrete, mkpolytype (ctyp t))) :: l]
     | CgVal loc s b v t ->
         [mkctf loc (Pctf_val (s, mkmutable b, mkvirtual v, ctyp t)) :: l]
     | CgVir loc s b t ->
-        [mkctf loc (Pctf_virt (s, mkprivate b, mkpolytype (ctyp t))) :: l]
+        [mkctf loc (Pctf_method (s, mkprivate b, Virtual, mkpolytype (ctyp t))) :: l]
     | CgAnt _ _ -> assert False ]
   and class_expr =
     fun
@@ -1186,37 +1214,40 @@ value varify_constructors var_names =
         in
         let cil = class_str_item cfl [] in
         mkcl loc (Pcl_structure {
-          pcstr_pat = patt p;
+          pcstr_self = patt p;
           pcstr_fields = cil;
         })
     | CeTyc loc ce ct ->
         mkcl loc (Pcl_constraint (class_expr ce) (class_type ct))
+    | CeAtt loc s str e ->
+        let e = class_expr e in
+        {(e) with pcl_attributes = e.pcl_attributes @ [attribute loc s str]}
     | CeCon loc _ _ _ ->
         error loc "invalid virtual class inside a class expression"
     | CeAnt _ _ | CeEq _ _ _ | CeAnd _ _ _ | CeNil _ -> assert False ]
   and class_str_item c l =
     match c with
     [ CrNil _ -> l
-    | CrCtr loc t1 t2 -> [mkcf loc (Pcf_constr (ctyp t1, ctyp t2)) :: l]
+    | CrCtr loc t1 t2 -> [mkcf loc (Pcf_constraint (ctyp t1, ctyp t2)) :: l]
     | <:class_str_item< $cst1$; $cst2$ >> ->
         class_str_item cst1 (class_str_item cst2 l)
     | CrInh loc ov ce pb ->
         let opb = if pb = "" then None else Some pb in
-        [mkcf loc (Pcf_inher (override_flag loc ov) (class_expr ce) opb) :: l]
-    | CrIni loc e -> [mkcf loc (Pcf_init (expr e)) :: l]
+        [mkcf loc (Pcf_inherit (override_flag loc ov) (class_expr ce) opb) :: l]
+    | CrIni loc e -> [mkcf loc (Pcf_initializer (expr e)) :: l]
     | CrMth loc s ov pf e t ->
         let t =
           match t with
           [ <:ctyp<>> -> None
           | t -> Some (mkpolytype (ctyp t)) ] in
         let e = mkexp loc (Pexp_poly (expr e) t) in
-        [mkcf loc (Pcf_meth (with_loc s loc, mkprivate pf, override_flag loc ov, e)) :: l]
+        [mkcf loc (Pcf_method (with_loc s loc, mkprivate pf, Cfk_concrete (override_flag loc ov, e))) :: l]
     | CrVal loc s ov mf e ->
-        [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, override_flag loc ov, expr e)) :: l]
+        [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, Cfk_concrete (override_flag loc ov, expr e))) :: l]
     | CrVir loc s pf t ->
-        [mkcf loc (Pcf_virt (with_loc s loc, mkprivate pf, mkpolytype (ctyp t))) :: l]
+        [mkcf loc (Pcf_method (with_loc s loc, mkprivate pf, Cfk_virtual (mkpolytype (ctyp t)))) :: l]
     | CrVvr loc s mf t ->
-        [mkcf loc (Pcf_valvirt (with_loc s loc, mkmutable mf, ctyp t)) :: l]
+        [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, Cfk_virtual (ctyp t))) :: l]
     | CrAnt _ _ -> assert False ];
 
   value sig_item ast = sig_item ast [];
@@ -1237,4 +1268,10 @@ value varify_constructors var_names =
     [ StDir _ d dp -> Ptop_dir d (directive dp)
     | si -> Ptop_def (str_item si) ]
   ;
+
+  value attribute loc s str =
+    (with_loc s loc, PStr (str_item str));
+
+  value () =
+    attribute_fwd.val := attribute;
 end;
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
index 940e2a101..60bb502c5 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
@@ -339,7 +339,10 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     ;
     (* Patterns *)
     patt:
-      [ "as" LEFTA
+      [  "attribute"
+        [ e = SELF; "[@"; s = a_LIDENT; str = str_items; "]" ->
+            Ast.PaAtt _loc s str e  ]
+      | "as" LEFTA
         [ p1 = SELF; "as"; i = a_LIDENT -> <:patt< ($p1$ as $lid:i$) >> ]
       | "|" LEFTA
         [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ]
@@ -500,6 +503,9 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
             let t = <:ctyp< $t1$ $t2$ >> in
             try <:ctyp< $id:Ast.ident_of_ctyp t$ >>
             with [ Invalid_argument s -> raise (Stream.Error s) ] ]
+      | "attribute"
+        [ e = SELF; "[@"; s = a_LIDENT; str = str_items; "]" ->
+            Ast.TyAtt _loc s str e ]
       | "simple"
         [ "'"; i = a_ident -> <:ctyp< '$i$ >>
         | "_" -> <:ctyp< _ >>
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
index 54b2c2817..20db511ee 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
@@ -627,7 +627,10 @@ New syntax:\
         | "while"; e = sequence; "do"; seq = do_sequence ->
             <:expr< while $mksequence' _loc e$ do { $seq$ } >>
         | "object"; csp = opt_class_self_patt; cst = class_structure; "end" ->
-            <:expr< object ($csp$) $cst$ end >> ]
+            <:expr< object ($csp$) $cst$ end >>
+        | e = SELF; "[@"; s = a_LIDENT; str = str_items; "]" ->
+            Ast.ExAtt _loc s str e
+             ]
       | "where"
         [ e = SELF; "where"; rf = opt_rec; lb = let_binding ->
             <:expr< let $rec:rf$ $lb$ in $e$ >> ]
@@ -878,7 +881,10 @@ New syntax:\
         | "->"; e = expr -> e ] ]
     ;
     patt:
-      [ "|" LEFTA
+      [ "attribute"
+        [ e = SELF; "[@"; s = a_LIDENT; str = str_items; "]" ->
+            Ast.PaAtt _loc s str e ]
+      | "|" LEFTA
         [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ]
       | ".." NONA
         [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ]
@@ -1099,6 +1105,9 @@ New syntax:\
         [ t1 = SELF; "."; t2 = SELF ->
             try <:ctyp< $id:Ast.ident_of_ctyp t1$.$id:Ast.ident_of_ctyp t2$ >>
             with [ Invalid_argument s -> raise (Stream.Error s) ] ]
+      | "attribute"
+        [ e = SELF; "[@"; s = a_LIDENT; str = str_items; "]" ->
+            Ast.TyAtt _loc s str e ]
       | "simple"
         [ "'"; i = a_ident -> <:ctyp< '$i$ >>
         | "_" -> <:ctyp< _ >>
diff --git a/camlp4/Camlp4Top/Rprint.ml b/camlp4/Camlp4Top/Rprint.ml
index 9e49aa0f5..0840c2892 100644
--- a/camlp4/Camlp4Top/Rprint.ml
+++ b/camlp4/Camlp4Top/Rprint.ml
@@ -329,7 +329,7 @@ value rec print_out_class_type ppf =
               (print_typlist Toploop.print_out_type.val ",") tyl ]
       in
       fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
-  | Octy_fun lab ty cty ->
+  | Octy_arrow lab ty cty ->
       fprintf ppf "@[%a[ %a ] ->@ %a@]" print_ty_label lab
         Toploop.print_out_type.val ty print_out_class_type cty
   | Octy_signature self_ty csil ->
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml
index 672ebd99e..3bfde79e5 100644
--- a/camlp4/boot/Camlp4.ml
+++ b/camlp4/boot/Camlp4.ml
@@ -14154,8 +14154,6 @@ module Struct =
               
             open Ast
               
-            let constructors_arity () = !Camlp4_config.constructors_arity
-              
             let error loc str = Loc.raise loc (Failure str)
               
             let char_of_char_token loc s =
@@ -14184,31 +14182,29 @@ module Struct =
             let with_loc txt loc =
               Camlp4_import.Location.mkloc txt (mkloc loc)
               
-            let mktyp loc d = { ptyp_desc = d; ptyp_loc = mkloc loc; }
+            let mktyp loc d = { ptyp_desc = d; ptyp_loc = mkloc loc; ptyp_attributes = []}
               
-            let mkpat loc d = { ppat_desc = d; ppat_loc = mkloc loc; }
+            let mkpat loc d = { ppat_desc = d; ppat_loc = mkloc loc; ppat_attributes = []}
               
-            let mkghpat loc d = { ppat_desc = d; ppat_loc = mkghloc loc; }
+            let mkghpat loc d = { ppat_desc = d; ppat_loc = mkghloc loc; ppat_attributes = []}
               
-            let mkexp loc d = { pexp_desc = d; pexp_loc = mkloc loc; }
+            let mkexp loc d = { pexp_desc = d; pexp_loc = mkloc loc; pexp_attributes = []}
               
-            let mkmty loc d = { pmty_desc = d; pmty_loc = mkloc loc; }
+            let mkmty loc d = { pmty_desc = d; pmty_loc = mkloc loc; pmty_attributes = []}
               
             let mksig loc d = { psig_desc = d; psig_loc = mkloc loc; }
               
-            let mkmod loc d = { pmod_desc = d; pmod_loc = mkloc loc; }
+            let mkmod loc d = { pmod_desc = d; pmod_loc = mkloc loc; pmod_attributes = []}
               
             let mkstr loc d = { pstr_desc = d; pstr_loc = mkloc loc; }
               
-            let mkfield loc d = { pfield_desc = d; pfield_loc = mkloc loc; }
-              
-            let mkcty loc d = { pcty_desc = d; pcty_loc = mkloc loc; }
+            let mkcty loc d = { pcty_desc = d; pcty_loc = mkloc loc; pcty_attributes = []}
               
-            let mkcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; }
+            let mkcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; pcl_attributes = []}
               
-            let mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; }
+            let mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; pcf_attributes = [] }
               
-            let mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; }
+            let mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; pctf_attributes = [] }
               
             let mkpolytype t =
               match t.ptyp_desc with
@@ -14380,7 +14376,7 @@ module Struct =
                   let (is_cls, li) = ctyp_long_id f
                   in
                     if is_cls
-                    then mktyp loc (Ptyp_class (li, (List.map ctyp al), []))
+                    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)))
@@ -14392,12 +14388,12 @@ module Struct =
               | 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 []))
+                  mktyp loc (Ptyp_object (meth_list fl [], Closed))
               | Ast.TyObj (loc, fl, Ast.RvRowVar) ->
                   mktyp loc
-                    (Ptyp_object (meth_list fl [ mkfield loc Pfield_var ]))
+                    (Ptyp_object (meth_list fl [], Open))
               | TyCls (loc, id) ->
-                  mktyp loc (Ptyp_class ((ident id), [], []))
+                  mktyp loc (Ptyp_class ((ident id), []))
               | Ast.TyPkg (loc, pt) ->
                   let (i, cs) = package_type pt
                   in mktyp loc (Ptyp_package (i, cs))
@@ -14429,14 +14425,14 @@ module Struct =
                     (Ptyp_tuple
                        (List.map ctyp (list_of_ctyp t1 (list_of_ctyp t2 []))))
               | Ast.TyVrnEq (loc, t) ->
-                  mktyp loc (Ptyp_variant ((row_field t), true, None))
+                  mktyp loc (Ptyp_variant ((row_field t), Closed, None))
               | Ast.TyVrnSup (loc, t) ->
-                  mktyp loc (Ptyp_variant ((row_field t), false, None))
+                  mktyp loc (Ptyp_variant ((row_field t), Open, None))
               | Ast.TyVrnInf (loc, t) ->
-                  mktyp loc (Ptyp_variant ((row_field t), true, (Some [])))
+                  mktyp loc (Ptyp_variant ((row_field t), Closed, (Some [])))
               | Ast.TyVrnInfSup (loc, t, t') ->
                   mktyp loc
-                    (Ptyp_variant ((row_field t), true,
+                    (Ptyp_variant ((row_field t), Closed,
                        (Some (name_tags t'))))
               | TyAnt (loc, _) -> error loc "antiquotation not allowed here"
               | TyOfAmp (_, _, _) | TyAmp (_, _, _) | TySta (_, _, _) |
@@ -14464,7 +14460,7 @@ module Struct =
               | 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
+                  (lab, (mkpolytype (ctyp t))) :: acc
               | _ -> assert false
             and package_type_constraints wc acc =
               match wc with
@@ -14484,17 +14480,16 @@ module Struct =
               | Ast.MtId (_, i) -> ((long_uident i), [])
               | mt -> error (loc_of_module_type mt) "unexpected package type"
               
-            let mktype loc tl cl tk tp tm =
-              let (params, variance) = List.split tl
-              in
+            let mktype loc name tl cl tk tp tm =
                 {
-                  ptype_params = params;
+                  ptype_name = name;
+                  ptype_params = tl;
                   ptype_cstrs = cl;
                   ptype_kind = tk;
                   ptype_private = tp;
                   ptype_manifest = tm;
                   ptype_loc = mkloc loc;
-                  ptype_variance = variance;
+                  ptype_attributes = [];
                 }
               
             let mkprivate' m = if m then Private else Public
@@ -14509,46 +14504,50 @@ module Struct =
               function
               | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))),
                   (Ast.TyMut (_, t))) ->
-                  ((with_loc s sloc), Mutable, (mkpolytype (ctyp t)),
-                   (mkloc loc))
+                    {pld_name=with_loc s sloc;
+                     pld_mutable=Mutable;
+                     pld_type=mkpolytype (ctyp t);
+                     pld_loc=mkloc loc;
+                     pld_attributes=[];
+                    }
               | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))), t) ->
-                  ((with_loc s sloc), Immutable, (mkpolytype (ctyp t)),
-                   (mkloc loc))
+                  {pld_name=with_loc s sloc;
+                   pld_mutable=Immutable;
+                   pld_type=mkpolytype (ctyp t);
+                   pld_loc=mkloc loc;
+                   pld_attributes=[];
+                  }
               | _ -> assert false
               
             let mkvariant =
               function
               | Ast.TyId (loc, (Ast.IdUid (sloc, s))) ->
-                  ((with_loc (conv_con s) sloc), [], None, (mkloc loc))
+                  {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
               | Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) ->
-                  ((with_loc (conv_con s) sloc),
-                   (List.map ctyp (list_of_ctyp t [])), None, (mkloc loc))
+                  {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
               | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))),
                   (Ast.TyArr (_, t, u))) ->
-                  ((with_loc (conv_con s) sloc),
-                   (List.map ctyp (list_of_ctyp t [])), (Some (ctyp u)),
-                   (mkloc loc))
+                  {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = Some (ctyp u); pcd_loc = mkloc loc; pcd_attributes = []}
               | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) ->
-                  ((with_loc (conv_con s) sloc), [], (Some (ctyp t)),
-                   (mkloc loc))
+                  {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = Some (ctyp t); pcd_loc = mkloc loc; pcd_attributes = []}
               | _ -> assert false
               
-            let rec type_decl tl cl loc m pflag =
+            let rec type_decl name tl cl loc m pflag =
               function
               | Ast.TyMan (_, t1, t2) ->
-                  type_decl tl cl loc (Some (ctyp t1)) pflag t2
+                  type_decl name tl cl loc (Some (ctyp t1)) pflag t2
               | Ast.TyPrv (_loc, t) ->
                   if pflag
                   then
                     error _loc
                       "multiple private keyword used, use only one instead"
-                  else type_decl tl cl loc m true t
+                  else type_decl name tl cl loc m true t
               | Ast.TyRec (_, t) ->
-                  mktype loc tl cl
+                  mktype loc name tl cl
                     (Ptype_record (List.map mktrecord (list_of_ctyp t [])))
                     (mkprivate' pflag) m
               | Ast.TySum (_, t) ->
-                  mktype loc tl cl
+                  mktype loc name tl cl
                     (Ptype_variant (List.map mkvariant (list_of_ctyp t [])))
                     (mkprivate' pflag) m
               | t ->
@@ -14560,12 +14559,15 @@ module Struct =
                        match t with
                        | Ast.TyNil _ -> None
                        | _ -> Some (ctyp t)
-                     in mktype loc tl cl Ptype_abstract (mkprivate' pflag) m)
+                     in mktype loc name tl cl Ptype_abstract (mkprivate' pflag) m)
               
-            let type_decl tl cl t loc = type_decl tl cl loc None false t
+            let type_decl name tl cl t loc = type_decl name tl cl loc None false t
               
-            let mkvalue_desc loc t p =
-              { pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc; }
+            let mkvalue_desc loc name t p =
+              { pval_name = name;
+                pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc;
+                pval_attributes = [];
+               }
               
             let rec list_of_meta_list =
               function
@@ -14608,14 +14610,14 @@ module Struct =
                   optional_type_parameters t1
                     (optional_type_parameters t2 acc)
               | Ast.TyQuP (loc, s) ->
-                  ((Some (with_loc s loc)), (true, false)) :: acc
-              | Ast.TyAnP _loc -> (None, (true, false)) :: acc
+                  ((Some (with_loc s loc)), Covariant) :: acc
+              | Ast.TyAnP _loc -> (None, Covariant) :: acc
               | Ast.TyQuM (loc, s) ->
-                  ((Some (with_loc s loc)), (false, true)) :: acc
-              | Ast.TyAnM _loc -> (None, (false, true)) :: acc
+                  ((Some (with_loc s loc)), Contravariant) :: acc
+              | Ast.TyAnM _loc -> (None, Contravariant) :: acc
               | Ast.TyQuo (loc, s) ->
-                  ((Some (with_loc s loc)), (false, false)) :: acc
-              | Ast.TyAny _loc -> (None, (false, false)) :: acc
+                  ((Some (with_loc s loc)), Invariant) :: acc
+              | Ast.TyAny _loc -> (None, Invariant) :: acc
               | _ -> assert false
               
             let rec class_parameters t acc =
@@ -14623,11 +14625,11 @@ module Struct =
               | Ast.TyCom (_, t1, t2) ->
                   class_parameters t1 (class_parameters t2 acc)
               | Ast.TyQuP (loc, s) ->
-                  ((with_loc s loc), (true, false)) :: acc
+                  ((with_loc s loc), Covariant) :: acc
               | Ast.TyQuM (loc, s) ->
-                  ((with_loc s loc), (false, true)) :: acc
+                  ((with_loc s loc), Contravariant) :: acc
               | Ast.TyQuo (loc, s) ->
-                  ((with_loc s loc), (false, false)) :: acc
+                  ((with_loc s loc), Invariant) :: acc
               | _ -> assert false
               
             let rec type_parameters_and_type_name t acc =
@@ -14640,34 +14642,37 @@ module Struct =
               
             let mkwithtyp pwith_type loc id_tpl ct =
               let (id, tpl) = type_parameters_and_type_name id_tpl [] in
-              let (params, variance) = List.split tpl in
               let (kind, priv, ct) = opt_private_ctyp ct
               in
-                (id,
-                 (pwith_type
+                 pwith_type id
                     {
-                      ptype_params = params;
+                      ptype_name = Camlp4_import.Location.mkloc (Camlp4_import.Longident.last id.txt) id.loc;
+                      ptype_params = tpl;
                       ptype_cstrs = [];
                       ptype_kind = kind;
                       ptype_private = priv;
                       ptype_manifest = Some ct;
                       ptype_loc = mkloc loc;
-                      ptype_variance = variance;
-                    }))
+                      ptype_attributes = [];
+                    }
               
             let rec mkwithc wc acc =
               match wc with
               | Ast.WcNil _ -> acc
               | Ast.WcTyp (loc, id_tpl, ct) ->
-                  (mkwithtyp (fun x -> Pwith_type x) loc id_tpl ct) :: acc
+                  (mkwithtyp (fun lid x -> Pwith_type (lid, x)) loc id_tpl ct) :: acc
               | Ast.WcMod (_, i1, i2) ->
-                  ((long_uident i1), (Pwith_module (long_uident i2))) :: acc
+                  (Pwith_module (long_uident i1, long_uident i2)) :: acc
               | Ast.WcTyS (loc, id_tpl, ct) ->
-                  (mkwithtyp (fun x -> Pwith_typesubst x) loc id_tpl ct) ::
-                    acc
-              | Ast.WcMoS (_, i1, i2) ->
-                  ((long_uident i1), (Pwith_modsubst (long_uident i2))) ::
+                  (mkwithtyp (fun _ x -> Pwith_typesubst x) loc id_tpl ct) ::
                     acc
+              | Ast.WcMoS (loc, i1, i2) ->
+                  begin match long_uident i1 with
+                  | {txt=Lident s; loc} ->
+                      (Pwith_modsubst ({txt=s;loc},long_uident i2)) ::
+                      acc
+                  | _ -> error loc "bad 'with module :=' constraint"
+                  end
               | Ast.WcAnd (_, wc1, wc2) -> mkwithc wc1 (mkwithc wc2 acc)
               | Ast.WcAnt (loc, _) ->
                   error loc "bad with constraint (antiquotation)"
@@ -14703,8 +14708,7 @@ module Struct =
                   mkpat loc (Ppat_var (with_loc s sloc))
               | Ast.PaId (loc, i) ->
                   let p =
-                    Ppat_construct ((long_uident ~conv_con i), None,
-                      (constructors_arity ()))
+                    Ppat_construct ((long_uident ~conv_con i), None)
                   in mkpat loc p
               | PaAli (loc, p1, p2) ->
                   let (p, i) =
@@ -14721,34 +14725,25 @@ module Struct =
                   (Ast.PaTup (_, (Ast.PaAny loc_any)))) ->
                   mkpat loc
                     (Ppat_construct ((lident_with_loc (conv_con s) sloc),
-                       (Some (mkpat loc_any Ppat_any)), false))
+                       (Some (mkpat loc_any Ppat_any))))
               | (PaApp (loc, _, _) as f) ->
                   let (f, al) = patt_fa [] f in
                   let al = List.map patt al
                   in
                     (match (patt f).ppat_desc with
-                     | Ppat_construct (li, None, _) ->
-                         if constructors_arity ()
-                         then
-                           mkpat loc
-                             (Ppat_construct (li,
-                                (Some (mkpat loc (Ppat_tuple al))), true))
-                         else
-                           (let a =
+                     | Ppat_construct (li, None) ->
+                           let a =
                               match al with
                               | [ a ] -> a
                               | _ -> mkpat loc (Ppat_tuple al)
-                            in
+                           in
                               mkpat loc
-                                (Ppat_construct (li, (Some a), false)))
+                                (Ppat_construct (li, (Some a)))
                      | Ppat_variant (s, None) ->
                          let a =
-                           if constructors_arity ()
-                           then mkpat loc (Ppat_tuple al)
-                           else
-                             (match al with
-                              | [ a ] -> a
-                              | _ -> mkpat loc (Ppat_tuple al))
+                             match al with
+                             | [ a ] -> a
+                             | _ -> mkpat loc (Ppat_tuple al)
                          in mkpat loc (Ppat_variant (s, (Some a)))
                      | _ ->
                          error (loc_of_patt f)
@@ -14819,7 +14814,7 @@ module Struct =
               | PaStr (loc, s) ->
                   mkpat loc
                     (Ppat_constant
-                       (Const_string (string_of_string_token loc s)))
+                       (Const_string (string_of_string_token loc s, None)))
               | Ast.PaTup (loc, (Ast.PaCom (_, p1, p2))) ->
                   mkpat loc
                     (Ppat_tuple
@@ -14895,10 +14890,10 @@ module Struct =
                       List.mem s var_names -> Ptyp_var ("&" ^ s)
                   | Ptyp_constr (longident, lst) ->
                       Ptyp_constr (longident, (List.map loop lst))
-                  | Ptyp_object lst ->
-                      Ptyp_object (List.map loop_core_field lst)
-                  | Ptyp_class (longident, lst, lbl_list) ->
-                      Ptyp_class ((longident, (List.map loop lst), lbl_list))
+                  | Ptyp_object (lst, o) ->
+                      Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+                  | Ptyp_class (longident, lst) ->
+                      Ptyp_class ((longident, (List.map loop lst)))
                   | Ptyp_alias (core_type, string) ->
                       Ptyp_alias (((loop core_type), string))
                   | Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
@@ -14912,12 +14907,6 @@ module Struct =
                         ((longident,
                           (List.map (fun (n, typ) -> (n, (loop typ))) lst)))
                 in { (t) with ptyp_desc = desc; }
-              and loop_core_field t =
-                let desc =
-                  match t.pfield_desc with
-                  | Pfield ((n, typ)) -> Pfield ((n, (loop typ)))
-                  | Pfield_var -> Pfield_var
-                in { (t) with pfield_desc = desc; }
               and loop_row_field x =
                 match x with
                 | Rtag ((label, flag, lst)) ->
@@ -14937,11 +14926,9 @@ module Struct =
                   let (e, l) =
                     (match sep_expr_acc [] e with
                      | (loc, ml, Ast.ExId (sloc, (Ast.IdUid (_, s)))) :: l ->
-                         let ca = constructors_arity ()
-                         in
                            ((mkexp loc
                                (Pexp_construct ((mkli sloc (conv_con s) ml),
-                                  None, ca))),
+                                  None))),
                             l)
                      | (loc, ml, Ast.ExId (sloc, (Ast.IdLid (_, s)))) :: l ->
                          ((mkexp loc (Pexp_ident (mkli sloc s ml))), l)
@@ -14969,31 +14956,22 @@ module Struct =
                   let al = List.map label_expr al
                   in
                     (match (expr f).pexp_desc with
-                     | Pexp_construct (li, None, _) ->
+                     | Pexp_construct (li, None) ->
                          let al = List.map snd al
                          in
-                           if constructors_arity ()
-                           then
-                             mkexp loc
-                               (Pexp_construct (li,
-                                  (Some (mkexp loc (Pexp_tuple al))), true))
-                           else
-                             (let a =
+                             let a =
                                 match al with
                                 | [ a ] -> a
                                 | _ -> mkexp loc (Pexp_tuple al)
-                              in
+                             in
                                 mkexp loc
-                                  (Pexp_construct (li, (Some a), false)))
+                                  (Pexp_construct (li, (Some a)))
                      | Pexp_variant (s, None) ->
                          let al = List.map snd al in
                          let a =
-                           if constructors_arity ()
-                           then mkexp loc (Pexp_tuple al)
-                           else
-                             (match al with
-                              | [ a ] -> a
-                              | _ -> mkexp loc (Pexp_tuple al))
+                             match al with
+                             | [ a ] -> a
+                             | _ -> mkexp loc (Pexp_tuple al)
                          in mkexp loc (Pexp_variant (s, (Some a)))
                      | _ -> mkexp loc (Pexp_apply ((expr f), al)))
               | ExAre (loc, e1, e2) ->
@@ -15004,7 +14982,7 @@ module Struct =
                        [ ("", (expr e1)); ("", (expr e2)) ]))
               | ExArr (loc, e) ->
                   mkexp loc (Pexp_array (List.map expr (list_of_expr e [])))
-              | ExAsf loc -> mkexp loc Pexp_assertfalse
+              | ExAsf loc -> mkexp loc (Pexp_assert (mkexp loc (Pexp_construct ({txt=Lident "false"; loc=mkloc loc}, None))))
               | ExAss (loc, e, v) ->
                   let e =
                     (match e with
@@ -15043,7 +15021,7 @@ module Struct =
                     (match t1 with | Ast.TyNil _ -> None | t -> Some (ctyp t))
                   in
                     mkexp loc
-                      (Pexp_constraint ((expr e), t1, (Some (ctyp t2))))
+                      (Pexp_coerce ((expr e), t1, ctyp t2))
               | ExFlo (loc, s) ->
                   mkexp loc
                     (Pexp_constant (Const_float (remove_underscores s)))
@@ -15055,25 +15033,19 @@ module Struct =
                          (mkdirection df), (expr e3)))
               | Ast.ExFun (loc, (Ast.McArr (_, (PaLab (_, lab, po)), w, e)))
                   ->
-                  mkexp loc
-                    (Pexp_function (lab, None,
-                       [ ((patt_of_lab loc lab po), (when_expr e w)) ]))
+                  mkfun loc lab None (patt_of_lab loc lab po) e w
               | Ast.ExFun (loc,
                   (Ast.McArr (_, (PaOlbi (_, lab, p, e1)), w, e2))) ->
                   let lab = paolab lab p
                   in
-                    mkexp loc
-                      (Pexp_function (("?" ^ lab), (Some (expr e1)),
-                         [ ((patt p), (when_expr e2 w)) ]))
+                  mkfun loc ("?" ^ lab) (Some (expr e1)) (patt p) e2 w
               | Ast.ExFun (loc, (Ast.McArr (_, (PaOlb (_, lab, p)), w, e)))
                   ->
                   let lab = paolab lab p
                   in
-                    mkexp loc
-                      (Pexp_function (("?" ^ lab), None,
-                         [ ((patt_of_lab loc lab p), (when_expr e w)) ]))
+                  mkfun loc ("?" ^ lab) None (patt_of_lab loc lab p) e w
               | ExFun (loc, a) ->
-                  mkexp loc (Pexp_function ("", None, (match_case a [])))
+                  mkexp loc (Pexp_function (match_case a []))
               | ExIfe (loc, e1, e2, e3) ->
                   mkexp loc
                     (Pexp_ifthenelse ((expr e1), (expr e2), (Some (expr e3))))
@@ -15128,7 +15100,7 @@ module Struct =
                   in
                     mkexp loc
                       (Pexp_object
-                         { pcstr_pat = patt p; pcstr_fields = cil; })
+                         { pcstr_self = patt p; pcstr_fields = cil; })
               | ExOlb (loc, _, _) ->
                   error loc "labeled expression not allowed here"
               | ExOvr (loc, iel) ->
@@ -15161,7 +15133,7 @@ module Struct =
               | ExStr (loc, s) ->
                   mkexp loc
                     (Pexp_constant
-                       (Const_string (string_of_string_token loc s)))
+                       (Const_string (string_of_string_token loc s, None)))
               | ExTry (loc, e, a) ->
                   mkexp loc (Pexp_try ((expr e), (match_case a [])))
               | Ast.ExTup (loc, (Ast.ExCom (_, e1, e2))) ->
@@ -15171,16 +15143,16 @@ module Struct =
               | Ast.ExTup (loc, _) -> error loc "singleton tuple"
               | ExTyc (loc, e, t) ->
                   mkexp loc
-                    (Pexp_constraint ((expr e), (Some (ctyp t)), None))
+                    (Pexp_constraint ((expr e), (ctyp t)))
               | Ast.ExId (loc, (Ast.IdUid (_, "()"))) ->
                   mkexp loc
-                    (Pexp_construct ((lident_with_loc "()" loc), None, true))
+                    (Pexp_construct ((lident_with_loc "()" loc), None))
               | Ast.ExId (loc, (Ast.IdLid (_, s))) ->
                   mkexp loc (Pexp_ident (lident_with_loc s loc))
               | Ast.ExId (loc, (Ast.IdUid (_, s))) ->
                   mkexp loc
                     (Pexp_construct ((lident_with_loc (conv_con s) loc),
-                       None, true))
+                       None))
               | ExVrn (loc, s) ->
                   mkexp loc (Pexp_variant ((conv_con s), None))
               | ExWhi (loc, e1, el) ->
@@ -15192,9 +15164,8 @@ module Struct =
               | Ast.ExPkg (loc, (Ast.MeTyc (_, me, pt))) ->
                   mkexp loc
                     (Pexp_constraint
-                       (((mkexp loc (Pexp_pack (module_expr me))),
-                         (Some (mktyp loc (Ptyp_package (package_type pt)))),
-                         None)))
+                       (mkexp loc (Pexp_pack (module_expr me)),
+                        mktyp loc (Ptyp_package (package_type pt))))
               | Ast.ExPkg (loc, me) -> mkexp loc (Pexp_pack (module_expr me))
               | ExFUN (loc, i, e) -> mkexp loc (Pexp_newtype (i, (expr e)))
               | Ast.ExCom (loc, _, _) ->
@@ -15239,7 +15210,7 @@ module Struct =
                   let mkpat = mkpat _loc in
                   let e =
                     mkexp
-                      (Pexp_constraint ((expr e), (Some (ctyp ty)), None)) in
+                      (Pexp_constraint ((expr e), (ctyp ty))) in
                   let rec mk_newtypes x =
                     (match x with
                      | [ newtype ] -> mkexp (Pexp_newtype ((newtype, e)))
@@ -15252,24 +15223,34 @@ module Struct =
                       (Ppat_constraint
                          (((mkpat (Ppat_var (with_loc bind_name sloc))),
                            (mktyp _loc (Ptyp_poly (ampersand_vars, ty')))))) in
-                  let e = mk_newtypes vars in (pat, e) :: acc
+                  let e = mk_newtypes vars in {pvb_pat=pat; pvb_expr=e; pvb_attributes=[]} :: acc
               | Ast.BiEq (_loc, p,
                   (Ast.ExTyc (_, e, (Ast.TyPol (_, vs, ty))))) ->
-                  ((patt (Ast.PaTyc (_loc, p, (Ast.TyPol (_loc, vs, ty))))),
-                   (expr e)) :: acc
-              | Ast.BiEq (_, p, e) -> ((patt p), (expr e)) :: acc
+                  {pvb_pat=patt (Ast.PaTyc (_loc, p, (Ast.TyPol (_loc, vs, ty))));
+                   pvb_expr=expr e;
+                   pvb_attributes=[]} :: acc
+              | Ast.BiEq (_, p, e) -> {pvb_pat=patt p; pvb_expr=expr e; pvb_attributes=[]} :: acc
               | Ast.BiNil _ -> acc
               | _ -> assert false
             and match_case x acc =
               match x with
               | Ast.McOr (_, x, y) -> match_case x (match_case y acc)
-              | Ast.McArr (_, p, w, e) -> ((patt p), (when_expr e w)) :: acc
+              | Ast.McArr (_, p, w, e) -> when_expr (patt p) e w :: acc
               | Ast.McNil _ -> acc
               | _ -> assert false
-            and when_expr e w =
-              match w with
-              | Ast.ExNil _ -> expr e
-              | w -> mkexp (loc_of_expr w) (Pexp_when ((expr w), (expr e)))
+            and when_expr p e w =
+              let g =
+                match w with
+                | Ast.ExNil _ -> None
+                | w -> Some (expr w)
+              in
+              {pc_lhs = p; pc_guard = g; pc_rhs = expr e}
+            and mkfun loc lab def p e w =
+              begin match w with
+              | Ast.ExNil _ -> ()
+              | _ -> assert false
+              end;
+              mkexp loc (Pexp_fun (lab, def, p, expr e))
             and mklabexp x acc =
               match x with
               | Ast.RbSem (_, x, y) -> mklabexp x (mklabexp y acc)
@@ -15295,11 +15276,10 @@ module Struct =
                          in ((ctyp t1), (ctyp t2), (mkloc loc)))
                       cl
                   in
-                    ((with_loc c cloc),
-                     (type_decl
-                        (List.fold_right optional_type_parameters tl []) cl
-                        td cloc)) ::
-                      acc
+                  (type_decl (with_loc c cloc)
+                     (List.fold_right optional_type_parameters tl []) cl
+                     td cloc) ::
+                  acc
               | _ -> assert false
             and module_type =
               function
@@ -15338,25 +15318,27 @@ module Struct =
               | SgDir (_, _, _) -> l
               | Ast.SgExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s))))) ->
                   (mksig loc
-                     (Psig_exception ((with_loc (conv_con s) loc), []))) ::
+                     (Psig_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=[];pcd_attributes=[]; pcd_loc=mkloc loc; pcd_res=None})) ::
                     l
               | Ast.SgExc (loc,
                   (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t))) ->
                   (mksig loc
-                     (Psig_exception ((with_loc (conv_con s) loc),
-                        (List.map ctyp (list_of_ctyp t []))))) ::
-                    l
+                     (Psig_exception {pcd_name=with_loc (conv_con s) loc;
+                                      pcd_args=List.map ctyp (list_of_ctyp t []);
+                                      pcd_loc = mkloc loc;
+                                      pcd_res = None;
+                                      pcd_attributes = []})) :: l
               | SgExc (_, _) -> assert false
               | SgExt (loc, n, t, sl) ->
                   (mksig loc
-                     (Psig_value ((with_loc n loc),
-                        (mkvalue_desc loc t (list_of_meta_list sl))))) ::
+                     (Psig_value
+                        (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl)))) ::
                     l
               | SgInc (loc, mt) ->
-                  (mksig loc (Psig_include (module_type mt))) :: l
+                  (mksig loc (Psig_include (module_type mt, []))) :: l
               | SgMod (loc, n, mt) ->
                   (mksig loc
-                     (Psig_module ((with_loc n loc), (module_type mt)))) ::
+                     (Psig_module {pmd_name=with_loc n loc; pmd_type=module_type mt; pmd_attributes=[]})) ::
                     l
               | SgRecMod (loc, mb) ->
                   (mksig loc (Psig_recmodule (module_sig_binding mb []))) ::
@@ -15364,16 +15346,16 @@ module Struct =
               | SgMty (loc, n, mt) ->
                   let si =
                     (match mt with
-                     | MtQuo (_, _) -> Pmodtype_abstract
-                     | _ -> Pmodtype_manifest (module_type mt))
-                  in (mksig loc (Psig_modtype ((with_loc n loc), si))) :: l
+                     | MtQuo (_, _) -> None
+                     | _ -> Some (module_type mt))
+                  in (mksig loc (Psig_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]})) :: l
               | SgOpn (loc, id) ->
-                  (mksig loc (Psig_open (Fresh, (long_uident id)))) :: l
+                  (mksig loc (Psig_open (Fresh, (long_uident id), []))) :: l
               | SgTyp (loc, tdl) ->
                   (mksig loc (Psig_type (mktype_decl tdl []))) :: l
               | SgVal (loc, n, t) ->
                   (mksig loc
-                     (Psig_value ((with_loc n loc), (mkvalue_desc loc t [])))) ::
+                     (Psig_value (mkvalue_desc loc (with_loc n loc) t []))) ::
                     l
               | Ast.SgAnt (loc, _) -> error loc "antiquotation in sig_item"
             and module_sig_binding x acc =
@@ -15381,15 +15363,20 @@ module Struct =
               | Ast.MbAnd (_, x, y) ->
                   module_sig_binding x (module_sig_binding y acc)
               | Ast.MbCol (loc, s, mt) ->
-                  ((with_loc s loc), (module_type mt)) :: acc
+                  {pmd_name=with_loc s loc; pmd_type=module_type mt; pmd_attributes=[]} :: acc
               | _ -> assert false
             and module_str_binding x acc =
               match x with
               | Ast.MbAnd (_, x, y) ->
                   module_str_binding x (module_str_binding y acc)
               | Ast.MbColEq (loc, s, mt, me) ->
-                  ((with_loc s loc), (module_type mt), (module_expr me)) ::
-                    acc
+                  {pmb_name=with_loc s loc;
+                   pmb_expr=
+                   {pmod_loc=Camlp4_import.Location.none;
+                    pmod_desc=Pmod_constraint(module_expr me,module_type mt);
+                    pmod_attributes=[];
+                   };
+                   pmb_attributes=[]} :: acc
               | _ -> assert false
             and module_expr =
               function
@@ -15413,9 +15400,7 @@ module Struct =
                        (mkexp loc
                           (Pexp_constraint
                              (((expr e),
-                               (Some
-                                  (mktyp loc (Ptyp_package (package_type pt)))),
-                               None)))))
+                               mktyp loc (Ptyp_package (package_type pt)))))))
               | Ast.MePkg (loc, e) -> mkmod loc (Pmod_unpack (expr e))
               | Ast.MeAnt (loc, _) ->
                   error loc "antiquotation in module_expr"
@@ -15439,47 +15424,53 @@ module Struct =
               | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), Ast.
                   ONone) ->
                   (mkstr loc
-                     (Pstr_exception ((with_loc (conv_con s) loc), []))) ::
+                     (Pstr_exception {pcd_name=with_loc (conv_con s) loc;pcd_args=[];pcd_attributes=[];pcd_res=None;pcd_loc=mkloc loc})) ::
                     l
               | Ast.StExc (loc,
                   (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t)), Ast.
                   ONone) ->
                   (mkstr loc
-                     (Pstr_exception ((with_loc (conv_con s) loc),
-                        (List.map ctyp (list_of_ctyp t []))))) ::
+                     (Pstr_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=List.map ctyp (list_of_ctyp t []);pcd_attributes=[];pcd_res=None;pcd_loc=mkloc loc})) ::
                     l
               | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))),
                   (Ast.OSome i)) ->
                   (mkstr loc
                      (Pstr_exn_rebind ((with_loc (conv_con s) loc),
-                        (long_uident ~conv_con i)))) ::
+                        (long_uident ~conv_con i), []))) ::
                     l
               | Ast.StExc (loc,
                   (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, _)))), _)),
                   (Ast.OSome _)) -> error loc "type in exception alias"
               | StExc (_, _, _) -> assert false
-              | StExp (loc, e) -> (mkstr loc (Pstr_eval (expr e))) :: l
+              | StExp (loc, e) -> (mkstr loc (Pstr_eval (expr e, []))) :: l
               | StExt (loc, n, t, sl) ->
                   (mkstr loc
-                     (Pstr_primitive ((with_loc n loc),
-                        (mkvalue_desc loc t (list_of_meta_list sl))))) ::
+                     (Pstr_primitive
+                        (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl)))) ::
                     l
               | StInc (loc, me) ->
-                  (mkstr loc (Pstr_include (module_expr me))) :: l
+                  (mkstr loc (Pstr_include (module_expr me, []))) :: l
               | StMod (loc, n, me) ->
                   (mkstr loc
-                     (Pstr_module ((with_loc n loc), (module_expr me)))) ::
-                    l
+                     (Pstr_module
+                        {pmb_name=with_loc n loc;
+                         pmb_expr=module_expr me;
+                         pmb_attributes=[]
+                        }
+                     ))
+                    :: l
               | StRecMod (loc, mb) ->
                   (mkstr loc (Pstr_recmodule (module_str_binding mb []))) ::
                     l
               | StMty (loc, n, mt) ->
-                  (mkstr loc
-                     (Pstr_modtype ((with_loc n loc), (module_type mt)))) ::
-                    l
+                  let si =
+                    (match mt with
+                     | MtQuo (_, _) -> None
+                     | _ -> Some (module_type mt))
+                  in (mkstr loc (Pstr_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]})) :: l
               | StOpn (loc, ov, id) ->
-                  let fresh = override_flag loc ov
-                  in (mkstr loc (Pstr_open (fresh, (long_uident id)))) :: l
+                  let fresh = override_flag loc ov in
+                  (mkstr loc (Pstr_open (fresh, (long_uident id), []))) :: l
               | StTyp (loc, tdl) ->
                   (mkstr loc (Pstr_type (mktype_decl tdl []))) :: l
               | StVal (loc, rf, bi) ->
@@ -15492,14 +15483,14 @@ module Struct =
                     (Pcty_constr ((long_class_ident id),
                        (List.map ctyp (list_of_opt_ctyp tl []))))
               | CtFun (loc, (TyLab (_, lab, t)), ct) ->
-                  mkcty loc (Pcty_fun (lab, (ctyp t), (class_type ct)))
+                  mkcty loc (Pcty_arrow (lab, (ctyp t), (class_type ct)))
               | CtFun (loc, (TyOlb (loc1, lab, t)), ct) ->
                   let t = TyApp (loc1, (predef_option loc1), t)
                   in
                     mkcty loc
-                      (Pcty_fun (("?" ^ lab), (ctyp t), (class_type ct)))
+                      (Pcty_arrow (("?" ^ lab), (ctyp t), (class_type ct)))
               | CtFun (loc, t, ct) ->
-                  mkcty loc (Pcty_fun ("", (ctyp t), (class_type ct)))
+                  mkcty loc (Pcty_arrow ("", (ctyp t), (class_type ct)))
               | CtSig (loc, t_o, ctfl) ->
                   let t =
                     (match t_o with | Ast.TyNil _ -> Ast.TyAny loc | t -> t) in
@@ -15510,7 +15501,6 @@ module Struct =
                          {
                            pcsig_self = ctyp t;
                            pcsig_fields = cil;
-                           pcsig_loc = mkloc loc;
                          })
               | CtCon (loc, _, _, _) ->
                   error loc "invalid virtual class inside a class type"
@@ -15520,20 +15510,18 @@ module Struct =
               match ci with
               | CeEq (_, (CeCon (loc, vir, (IdLid (nloc, name)), params)),
                   ce) ->
-                  let (loc_params, (params, variance)) =
+                  let params =
                     (match params with
-                     | Ast.TyNil _ -> (loc, ([], []))
-                     | t ->
-                         ((loc_of_ctyp t),
-                          (List.split (class_parameters t []))))
+                     | Ast.TyNil _ -> []
+                     | t -> class_parameters t [])
                   in
                     {
                       pci_virt = mkvirtual vir;
-                      pci_params = (params, (mkloc loc_params));
+                      pci_params = params;
                       pci_name = with_loc name nloc;
                       pci_expr = class_expr ce;
                       pci_loc = mkloc loc;
-                      pci_variance = variance;
+                      pci_attributes = [];
                     }
               | ce -> error (loc_of_class_expr ce) "bad class definition"
             and class_info_class_type ci =
@@ -15543,20 +15531,19 @@ module Struct =
                   CtCol (_, (CtCon (loc, vir, (IdLid (nloc, name)), params)),
                     ct)
                   ->
-                  let (loc_params, (params, variance)) =
+                  let params =
                     (match params with
-                     | Ast.TyNil _ -> (loc, ([], []))
+                     | Ast.TyNil _ -> []
                      | t ->
-                         ((loc_of_ctyp t),
-                          (List.split (class_parameters t []))))
+                          class_parameters t [])
                   in
                     {
                       pci_virt = mkvirtual vir;
-                      pci_params = (params, (mkloc loc_params));
+                      pci_params = params;
                       pci_name = with_loc name nloc;
                       pci_expr = class_type ct;
                       pci_loc = mkloc loc;
-                      pci_variance = variance;
+                      pci_attributes = [];
                     }
               | ct ->
                   error (loc_of_class_type ct)
@@ -15565,14 +15552,14 @@ module Struct =
               match c with
               | Ast.CgNil _ -> l
               | CgCtr (loc, t1, t2) ->
-                  (mkctf loc (Pctf_cstr (((ctyp t1), (ctyp t2))))) :: l
+                  (mkctf loc (Pctf_constraint (((ctyp t1), (ctyp t2))))) :: l
               | Ast.CgSem (_, csg1, csg2) ->
                   class_sig_item csg1 (class_sig_item csg2 l)
               | CgInh (loc, ct) ->
-                  (mkctf loc (Pctf_inher (class_type ct))) :: l
+                  (mkctf loc (Pctf_inherit (class_type ct))) :: l
               | CgMth (loc, s, pf, t) ->
                   (mkctf loc
-                     (Pctf_meth ((s, (mkprivate pf), (mkpolytype (ctyp t)))))) ::
+                     (Pctf_method ((s, (mkprivate pf), Concrete, (mkpolytype (ctyp t)))))) ::
                     l
               | CgVal (loc, s, b, v, t) ->
                   (mkctf loc
@@ -15580,7 +15567,7 @@ module Struct =
                     l
               | CgVir (loc, s, b, t) ->
                   (mkctf loc
-                     (Pctf_virt ((s, (mkprivate b), (mkpolytype (ctyp t)))))) ::
+                     (Pctf_method ((s, (mkprivate b), Virtual, (mkpolytype (ctyp t)))))) ::
                     l
               | CgAnt (_, _) -> assert false
             and class_expr =
@@ -15621,7 +15608,7 @@ module Struct =
                   in
                     mkcl loc
                       (Pcl_structure
-                         { pcstr_pat = patt p; pcstr_fields = cil; })
+                         { pcstr_self = patt p; pcstr_fields = cil; })
               | CeTyc (loc, ce, ct) ->
                   mkcl loc
                     (Pcl_constraint ((class_expr ce), (class_type ct)))
@@ -15633,17 +15620,17 @@ module Struct =
               match c with
               | CrNil _ -> l
               | CrCtr (loc, t1, t2) ->
-                  (mkcf loc (Pcf_constr (((ctyp t1), (ctyp t2))))) :: l
+                  (mkcf loc (Pcf_constraint (((ctyp t1), (ctyp t2))))) :: l
               | Ast.CrSem (_, cst1, cst2) ->
                   class_str_item cst1 (class_str_item cst2 l)
               | CrInh (loc, ov, ce, pb) ->
                   let opb = if pb = "" then None else Some pb
                   in
                     (mkcf loc
-                       (Pcf_inher ((override_flag loc ov), (class_expr ce),
+                       (Pcf_inherit ((override_flag loc ov), (class_expr ce),
                           opb))) ::
                       l
-              | CrIni (loc, e) -> (mkcf loc (Pcf_init (expr e))) :: l
+              | CrIni (loc, e) -> (mkcf loc (Pcf_initializer (expr e))) :: l
               | CrMth (loc, s, ov, pf, e, t) ->
                   let t =
                     (match t with
@@ -15652,26 +15639,26 @@ module Struct =
                   let e = mkexp loc (Pexp_poly ((expr e), t))
                   in
                     (mkcf loc
-                       (Pcf_meth
+                       (Pcf_method
                           (((with_loc s loc), (mkprivate pf),
-                            (override_flag loc ov), e)))) ::
+                            Cfk_concrete ((override_flag loc ov), e))))) ::
                       l
               | CrVal (loc, s, ov, mf, e) ->
                   (mkcf loc
                      (Pcf_val
                         (((with_loc s loc), (mkmutable mf),
-                          (override_flag loc ov), (expr e))))) ::
+                          Cfk_concrete ((override_flag loc ov), (expr e)))))) ::
                     l
               | CrVir (loc, s, pf, t) ->
                   (mkcf loc
-                     (Pcf_virt
+                     (Pcf_method
                         (((with_loc s loc), (mkprivate pf),
-                          (mkpolytype (ctyp t)))))) ::
+                          Cfk_virtual (mkpolytype (ctyp t)))))) ::
                     l
               | CrVvr (loc, s, mf, t) ->
                   (mkcf loc
-                     (Pcf_valvirt
-                        (((with_loc s loc), (mkmutable mf), (ctyp t))))) ::
+                     (Pcf_val
+                        (((with_loc s loc), (mkmutable mf), Cfk_virtual (ctyp t))))) ::
                     l
               | CrAnt (_, _) -> assert false
               
@@ -21660,3 +21647,4 @@ module Register :
   end
   
 
+
diff --git a/camlp4/boot/Camlp4Ast.ml b/camlp4/boot/Camlp4Ast.ml
index 1ceaa787a..913284e6d 100644
--- a/camlp4/boot/Camlp4Ast.ml
+++ b/camlp4/boot/Camlp4Ast.ml
@@ -107,6 +107,7 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
       | Ast.PaLab _ _ (Ast.PaNil _) -> True
       | Ast.PaLab _ _ p -> is_irrefut_patt p
       | Ast.PaLaz _ p -> is_irrefut_patt p
+      | Ast.PaAtt _loc _s _str p -> is_irrefut_patt p
       | Ast.PaId _ _ -> False
       | (* here one need to know the arity of constructors *) Ast.PaMod _ _
           -> True
@@ -520,6 +521,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_class_expr _loc =
                   fun
                   [ Ast.CeAnt x0 x1 -> Ast.ExAnt x0 x1
+                  | Ast.CeAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "CeAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_class_expr _loc x3)
                   | Ast.CeEq x0 x1 x2 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -792,6 +805,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_class_type _loc =
                   fun
                   [ Ast.CtAnt x0 x1 -> Ast.ExAnt x0 x1
+                  | Ast.CtAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "CtAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_class_type _loc x3)
                   | Ast.CtEq x0 x1 x2 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -863,6 +888,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_ctyp _loc =
                   fun
                   [ Ast.TyAnt x0 x1 -> Ast.ExAnt x0 x1
+                  | Ast.TyAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "TyAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_ctyp _loc x3)
                   | Ast.TyPkg x0 x1 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -1229,7 +1266,19 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                            (Ast.IdUid _loc "DiTo")) ]
                 and meta_expr _loc =
                   fun
-                  [ Ast.ExPkg x0 x1 ->
+                  [ Ast.ExAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "ExAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_expr _loc x3)
+                  | Ast.ExPkg x0 x1 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
                            (Ast.ExId _loc
@@ -1786,6 +1835,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_module_expr _loc =
                   fun
                   [ Ast.MeAnt x0 x1 -> Ast.ExAnt x0 x1
+                  | Ast.MeAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "MeAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_module_expr _loc x3)
                   | Ast.MePkg x0 x1 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -1851,6 +1912,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_module_type _loc =
                   fun
                   [ Ast.MtAnt x0 x1 -> Ast.ExAnt x0 x1
+                  | Ast.MtAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "MtAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_module_type _loc x3)
                   | Ast.MtOf x0 x1 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -1943,6 +2016,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                                  (Ast.IdUid _loc "PaMod")))
                            (meta_loc _loc x0))
                         (meta_string _loc x1)
+                  | Ast.PaAtt x0 x1 x2 x3 ->
+                      Ast.ExApp _loc
+                        (Ast.ExApp _loc
+                           (Ast.ExApp _loc
+                              (Ast.ExApp _loc
+                                 (Ast.ExId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "PaAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_patt _loc x3)
                   | Ast.PaLaz x0 x1 ->
                       Ast.ExApp _loc
                         (Ast.ExApp _loc
@@ -2631,6 +2716,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_class_expr _loc =
                   fun
                   [ Ast.CeAnt x0 x1 -> Ast.PaAnt x0 x1
+                  | Ast.CeAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "CeAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_class_expr _loc x3)
                   | Ast.CeEq x0 x1 x2 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -2903,6 +3000,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_class_type _loc =
                   fun
                   [ Ast.CtAnt x0 x1 -> Ast.PaAnt x0 x1
+                  | Ast.CtAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "CtAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_class_type _loc x3)
                   | Ast.CtEq x0 x1 x2 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -2974,6 +3083,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_ctyp _loc =
                   fun
                   [ Ast.TyAnt x0 x1 -> Ast.PaAnt x0 x1
+                  | Ast.TyAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "TyAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_ctyp _loc x3)
                   | Ast.TyPkg x0 x1 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -3340,7 +3461,19 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                            (Ast.IdUid _loc "DiTo")) ]
                 and meta_expr _loc =
                   fun
-                  [ Ast.ExPkg x0 x1 ->
+                  [ Ast.ExAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "ExAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_expr _loc x3)
+                  | Ast.ExPkg x0 x1 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
                            (Ast.PaId _loc
@@ -3897,6 +4030,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_module_expr _loc =
                   fun
                   [ Ast.MeAnt x0 x1 -> Ast.PaAnt x0 x1
+                  | Ast.MeAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "MeAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_module_expr _loc x3)
                   | Ast.MePkg x0 x1 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -3962,6 +4107,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                 and meta_module_type _loc =
                   fun
                   [ Ast.MtAnt x0 x1 -> Ast.PaAnt x0 x1
+                  | Ast.MtAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "MtAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_module_type _loc x3)
                   | Ast.MtOf x0 x1 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -4054,6 +4211,18 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
                                  (Ast.IdUid _loc "PaMod")))
                            (meta_loc _loc x0))
                         (meta_string _loc x1)
+                  | Ast.PaAtt x0 x1 x2 x3 ->
+                      Ast.PaApp _loc
+                        (Ast.PaApp _loc
+                           (Ast.PaApp _loc
+                              (Ast.PaApp _loc
+                                 (Ast.PaId _loc
+                                    (Ast.IdAcc _loc (Ast.IdUid _loc "Ast")
+                                       (Ast.IdUid _loc "PaAtt")))
+                                 (meta_loc _loc x0))
+                              (meta_string _loc x1))
+                           (meta_str_item _loc x2))
+                        (meta_patt _loc x3)
                   | Ast.PaLaz x0 x1 ->
                       Ast.PaApp _loc
                         (Ast.PaApp _loc
@@ -4960,6 +5129,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let _x_i1 = o#string _x_i1 in PaVrn _x _x_i1
           | PaLaz _x _x_i1 ->
               let _x = o#loc _x in let _x_i1 = o#patt _x_i1 in PaLaz _x _x_i1
+          | PaAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#patt _x_i3 in PaAtt _x _x_i1 _x_i2 _x_i3
           | PaMod _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in PaMod _x _x_i1 ];
@@ -4996,6 +5170,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
           | MtOf _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#module_expr _x_i1 in MtOf _x _x_i1
+          | MtAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#module_type _x_i3 in MtAtt _x _x_i1 _x_i2 _x_i3
           | MtAnt _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in MtAnt _x _x_i1 ];
@@ -5022,6 +5201,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let _x_i2 = o#module_type _x_i2 in MeTyc _x _x_i1 _x_i2
           | MePkg _x _x_i1 ->
               let _x = o#loc _x in let _x_i1 = o#expr _x_i1 in MePkg _x _x_i1
+          | MeAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#module_expr _x_i3 in MeAtt _x _x_i1 _x_i2 _x_i3
           | MeAnt _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in MeAnt _x _x_i1 ];
@@ -5273,7 +5457,12 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let _x_i2 = o#expr _x_i2 in ExFUN _x _x_i1 _x_i2
           | ExPkg _x _x_i1 ->
               let _x = o#loc _x in
-              let _x_i1 = o#module_expr _x_i1 in ExPkg _x _x_i1 ];
+              let _x_i1 = o#module_expr _x_i1 in ExPkg _x _x_i1
+          | ExAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#expr _x_i3 in ExAtt _x _x_i1 _x_i2 _x_i3 ];
         method direction_flag : direction_flag -> direction_flag =
           fun
           [ DiTo -> DiTo
@@ -5412,6 +5601,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
           | TyPkg _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#module_type _x_i1 in TyPkg _x _x_i1
+          | TyAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#ctyp _x_i3 in TyAtt _x _x_i1 _x_i2 _x_i3
           | TyAnt _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in TyAnt _x _x_i1 ];
@@ -5443,6 +5637,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let _x = o#loc _x in
               let _x_i1 = o#class_type _x_i1 in
               let _x_i2 = o#class_type _x_i2 in CtEq _x _x_i1 _x_i2
+          | CtAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#class_type _x_i3 in CtAtt _x _x_i1 _x_i2 _x_i3
           | CtAnt _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in CtAnt _x _x_i1 ];
@@ -5561,6 +5760,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let _x = o#loc _x in
               let _x_i1 = o#class_expr _x_i1 in
               let _x_i2 = o#class_expr _x_i2 in CeEq _x _x_i1 _x_i2
+          | CeAtt _x _x_i1 _x_i2 _x_i3 ->
+              let _x = o#loc _x in
+              let _x_i1 = o#string _x_i1 in
+              let _x_i2 = o#str_item _x_i2 in
+              let _x_i3 = o#class_expr _x_i3 in CeAtt _x _x_i1 _x_i2 _x_i3
           | CeAnt _x _x_i1 ->
               let _x = o#loc _x in
               let _x_i1 = o#string _x_i1 in CeAnt _x _x_i1 ];
@@ -5771,6 +5975,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
           | PaTyp _x _x_i1 -> let o = o#loc _x in let o = o#ident _x_i1 in o
           | PaVrn _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o
           | PaLaz _x _x_i1 -> let o = o#loc _x in let o = o#patt _x_i1 in o
+          | PaAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#patt _x_i3 in o
           | PaMod _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method override_flag : override_flag -> 'self_type =
           fun
@@ -5798,6 +6006,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let o = o#module_type _x_i1 in let o = o#with_constr _x_i2 in o
           | MtOf _x _x_i1 ->
               let o = o#loc _x in let o = o#module_expr _x_i1 in o
+          | MtAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#module_type _x_i3 in o
           | MtAnt _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method module_expr : module_expr -> 'self_type =
           fun
@@ -5816,6 +6028,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let o = o#loc _x in
               let o = o#module_expr _x_i1 in let o = o#module_type _x_i2 in o
           | MePkg _x _x_i1 -> let o = o#loc _x in let o = o#expr _x_i1 in o
+          | MeAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#module_expr _x_i3 in o
           | MeAnt _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method module_binding : module_binding -> 'self_type =
           fun
@@ -5982,7 +6198,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let o = o#loc _x in
               let o = o#string _x_i1 in let o = o#expr _x_i2 in o
           | ExPkg _x _x_i1 ->
-              let o = o#loc _x in let o = o#module_expr _x_i1 in o ];
+              let o = o#loc _x in let o = o#module_expr _x_i1 in o
+          | ExAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#expr _x_i3 in o ];
         method direction_flag : direction_flag -> 'self_type =
           fun
           [ DiTo -> o
@@ -6080,6 +6300,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
               let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o
           | TyPkg _x _x_i1 ->
               let o = o#loc _x in let o = o#module_type _x_i1 in o
+          | TyAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#ctyp _x_i3 in o
           | TyAnt _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method class_type : class_type -> 'self_type =
           fun
@@ -6103,6 +6327,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
           | CtEq _x _x_i1 _x_i2 ->
               let o = o#loc _x in
               let o = o#class_type _x_i1 in let o = o#class_type _x_i2 in o
+          | CtAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#class_type _x_i3 in o
           | CtAnt _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method class_str_item : class_str_item -> 'self_type =
           fun
@@ -6194,6 +6422,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
           | CeEq _x _x_i1 _x_i2 ->
               let o = o#loc _x in
               let o = o#class_expr _x_i1 in let o = o#class_expr _x_i2 in o
+          | CeAtt _x _x_i1 _x_i2 _x_i3 ->
+              let o = o#loc _x in
+              let o = o#string _x_i1 in
+              let o = o#str_item _x_i2 in let o = o#class_expr _x_i3 in o
           | CeAnt _x _x_i1 -> let o = o#loc _x in let o = o#string _x_i1 in o ];
         method binding : binding -> 'self_type =
           fun
diff --git a/experimental/frisch/Makefile b/experimental/frisch/Makefile
index 82a2563bc..113467bc4 100644
--- a/experimental/frisch/Makefile
+++ b/experimental/frisch/Makefile
@@ -1,24 +1,81 @@
 ROOT=../..
-OCAMLC=$(ROOT)/boot/ocamlrun $(ROOT)/ocamlc -I $(ROOT)/stdlib -I $(ROOT)/parsing -I $(ROOT)/utils -I $(ROOT)/tools -w A-4-9
+OCAMLC=$(ROOT)/boot/ocamlrun $(ROOT)/ocamlc -I $(ROOT)/stdlib -I $(ROOT)/parsing -I $(ROOT)/utils -I $(ROOT)/tools -I $(ROOT)/typing -I $(ROOT)/driver -I $(ROOT)/toplevel -w A-4-9
+COMMON=$(ROOT)/compilerlibs/ocamlcommon.cma
+BYTECMP=$(ROOT)/compilerlibs/ocamlbytecomp.cma
+TOPLVL=$(ROOT)/compilerlibs/ocamltoplevel.cma
 
-tracer.exe: tracer.ml
-	$(OCAMLC) -o $@ $(ROOT)/compilerlibs/ocamlcommon.cma $(ROOT)/tools/ast_mapper.cmo tracer.ml
-
-ifdef.exe: ifdef.ml
-	$(OCAMLC) -o $@ $(ROOT)/compilerlibs/ocamlcommon.cma $(ROOT)/tools/ast_mapper.cmo ifdef.ml
+clean:
+	rm -f *.exe *.cm* *~
 
-js_syntax.exe: js_syntax.ml
-	$(OCAMLC) -o $@ $(ROOT)/compilerlibs/ocamlcommon.cma $(ROOT)/tools/ast_mapper.cmo js_syntax.ml
 
+## Conditional compilation based on environment variables
 
-test_trace.exe: tracer.exe test_trace.ml
-	$(OCAMLC) -o test_trace.exe -ppx ./tracer.exe test_trace.ml
+.PHONY: ifdef
+ifdef:
+	$(OCAMLC) -o ifdef.exe -w +A-4 $(COMMON) ifdef.ml
+	$(OCAMLC) -o test_ifdef.exe -ppx ./ifdef.exe -dsource test_ifdef.ml
+	./test_ifdef.exe
 
-test_ifdef.exe: ifdef.exe test_ifdef.ml
-	$(OCAMLC) -o test_ifdef.exe -ppx ./ifdef.exe test_ifdef.ml
+## A proposal for replacing js_of_ocaml Camlp4 syntax extension with
+## a -ppx filter
 
-test_js.exe: js_syntax.exe test_js.ml
+.PHONY: js_syntax
+js_syntax:
+	$(OCAMLC) -o js_syntax.exe -w +A-4 $(COMMON) js_syntax.ml
 	$(OCAMLC) -o test_ifdef.exe -i -ppx ./js_syntax.exe test_js.ml
 
-clean:
-	rm -f *.exe *.cm*
+
+## A "toy" ocamldoc clone based on .cmti files
+
+.PHONY: minidoc
+minidoc:
+	$(OCAMLC) -custom -o minidoc.exe $(COMMON) minidoc.ml
+	$(OCAMLC) -c -bin-annot testdoc.mli
+	./minidoc.exe testdoc.cmti
+
+## Lifting the OCaml AST, used for:
+## (i)   creating a printer for Parsetree values
+## (ii)  quasi-quotations
+
+.PHONY: lifter
+lifter:
+	$(OCAMLC) -w +A-4 -custom -o genlifter.exe $(COMMON) genlifter.ml
+	./genlifter.exe -I ../../parsing -I ../../stdlib Parsetree.expression > ast_lifter.ml
+	$(OCAMLC) -c -w +A-17 ast_lifter.ml
+	$(OCAMLC) -c dumpast.ml
+	$(OCAMLC) -o dumpast.exe $(COMMON) ast_lifter.cmo dumpast.cmo
+	./dumpast.exe "fun x -> 1 + 3 * x" -p "x as y"
+	$(OCAMLC) -custom -o metaquot.exe -w +A-4 $(COMMON) ast_lifter.cmo metaquot.ml
+	$(OCAMLC) -custom -o metaquot_test.exe -w +A -ppx ./metaquot.exe $(COMMON) metaquot_test.ml
+	./metaquot_test.exe
+
+## Using the OCaml toplevel to evaluate expression during compilation
+
+.PHONY: eval
+eval:
+	$(OCAMLC) -linkall -o eval.exe -w +A-4 $(COMMON) $(BYTECMP) $(TOPLVL) eval.ml
+	$(OCAMLC) -o test_eval.exe -w +A -ppx ./eval.exe test_eval.ml
+
+## Example of code generation based on type declarations
+
+.PHONY: ppx_builder
+ppx_builder:
+	$(OCAMLC) -linkall -o ppx_builder.exe -w +A-4 $(COMMON) ppx_builder.ml
+	$(OCAMLC) -o test_builder.exe -w +A -ppx ./ppx_builder.exe -dsource test_builder.ml
+
+## Import type definitions from other source files (e.g. to avoid code
+## duplication between the .ml and .mli files)
+
+.PHONY: copy_typedef
+copy_typedef:
+	$(OCAMLC) -linkall -o copy_typedef.exe -w +A-4 $(COMMON) copy_typedef.ml
+	$(OCAMLC) -c -ppx ./copy_typedef.exe test_copy_typedef.mli
+	$(OCAMLC) -o test_copy_typedef.exe -w +A -ppx ./copy_typedef.exe -dsource test_copy_typedef.ml
+
+
+## Create mli files from ml files
+
+.PHONY: nomli
+nomli:
+	$(OCAMLC) -linkall -o nomli.exe -w +A-4-9 $(COMMON) $(BYTECMP) ../../tools/untypeast.cmo ../../tools/tast_iter.cmo nomli.ml
+	./nomli.exe test_nomli.ml
diff --git a/experimental/frisch/copy_typedef.ml b/experimental/frisch/copy_typedef.ml
new file mode 100644
index 000000000..baf52de4d
--- /dev/null
+++ b/experimental/frisch/copy_typedef.ml
@@ -0,0 +1,181 @@
+(*
+  A -ppx rewriter to copy type definitions from the interface into
+  the implementation.
+
+  In an .ml file, you can write:
+
+    type t = [%copy_typedef]
+
+  and the concrete definition will be copied from the corresponding .mli
+  file (looking for the type name in the same path).
+
+  The same is available for module types:
+
+    module type S = [%copy_typedef]
+
+  You can also import a definition from an arbitrary .ml/.mli file.
+  Example:
+
+   type loc = [%copy_typedef "../../parsing/location.mli" t]
+
+  Note: the definitions are imported textually without any substitution.
+*)
+
+module Main : sig end = struct
+  open Asttypes
+  open! Location
+  open Parsetree
+
+  let fatal loc s =
+    Location.print_error Format.err_formatter loc;
+    prerr_endline ("** copy_typedef: " ^ Printexc.to_string s);
+    exit 2
+
+  class maintain_path = object(this)
+    inherit Ast_mapper.mapper as super
+
+    val path = []
+
+    method! module_binding m = {< path = m.pmb_name.txt :: path >} # super_module_binding m
+    method super_module_binding = super # module_binding
+
+    method! module_declaration m = {< path = m.pmd_name.txt :: path >} # super_module_declaration m
+    method super_module_declaration = super # module_declaration
+
+    method! module_type_declaration m = {< path = m.pmtd_name.txt :: path >} # super_module_type_declaration m
+    method super_module_type_declaration = super # module_type_declaration
+
+    method! structure_item s =
+      let s =
+        match s.pstr_desc with
+        | Pstr_type tdecls -> {s with pstr_desc=Pstr_type (List.map (this # tydecl) tdecls)}
+        | Pstr_modtype mtd -> {s with pstr_desc=Pstr_modtype (this # mtydecl mtd)}
+        | _ -> s
+      in
+      super # structure_item s
+
+    method! signature_item s =
+      let s =
+        match s.psig_desc with
+        | Psig_type tdecls -> {s with psig_desc=Psig_type (List.map (this # tydecl) tdecls)}
+        | Psig_modtype mtd -> {s with psig_desc=Psig_modtype (this # mtydecl mtd)}
+        | _ -> s
+      in
+      super # signature_item s
+
+    method tydecl x = x
+    method mtydecl x = x
+  end
+
+  let memoize f =
+    let h = Hashtbl.create 16 in
+    fun x ->
+      try Hashtbl.find h x
+      with Not_found ->
+        let r = f x in
+        Hashtbl.add h x r;
+        r
+
+  let from_file file =
+    let types = Hashtbl.create 16 in
+    let mtypes = Hashtbl.create 16 in
+    let collect = object
+      inherit maintain_path
+      method! tydecl x =
+        Hashtbl.add types (path, x.ptype_name.txt) x;
+        x
+      method! mtydecl x =
+        Hashtbl.add mtypes (path, x.pmtd_name.txt) x;
+        x
+    end
+    in
+    let ic = open_in file in
+    let lexbuf = Lexing.from_channel ic in
+    if Filename.check_suffix file ".ml"
+    then ignore (collect # structure (Parse.implementation lexbuf))
+    else if Filename.check_suffix file ".mli"
+    then ignore (collect # signature (Parse.interface lexbuf))
+    else failwith (Printf.sprintf "Unknown extension for %s" file);
+    close_in ic;
+    object
+      method tydecl path name =
+        try Hashtbl.find types (path, name)
+        with Not_found ->
+          failwith
+            (Printf.sprintf "Cannot find type %s in file %s\n%!"
+               (String.concat "." (List.rev (name :: path))) file)
+
+      method mtydecl path name =
+        try Hashtbl.find mtypes (path, name)
+        with Not_found ->
+          failwith
+            (Printf.sprintf "Cannot find module type %s in file %s\n%!"
+               (String.concat "." (List.rev (name :: path))) file)
+    end
+
+  let from_file = memoize from_file
+
+  let copy = object(this)
+    inherit maintain_path as super
+
+    val mutable file = ""
+
+    method source name = function
+      | PStr [] ->
+          let file =
+            if Filename.check_suffix file ".ml"
+            then (Filename.chop_suffix file ".ml") ^ ".mli"
+            else if Filename.check_suffix file ".mli"
+            then (Filename.chop_suffix file ".mli") ^ ".ml"
+            else failwith "Unknown source extension"
+          in
+          file, path, name
+      | PStr [{pstr_desc=Pstr_eval
+            ({pexp_desc=Pexp_apply
+                ({pexp_desc=Pexp_constant(Const_string (file, _)); _},
+                 ["", {pexp_desc=Pexp_ident{txt=lid;_}; _}]); _}, _); _}] ->
+          begin match List.rev (Longident.flatten lid) with
+          | [] -> assert false
+          | name :: path -> file, path, name
+          end
+      | _ ->
+          failwith "Cannot parse argument"
+
+    method! tydecl = function
+      | {ptype_kind = Ptype_abstract;
+         ptype_manifest =
+         Some{ptyp_desc=Ptyp_extension({txt="copy_typedef";_}, arg); _};
+         ptype_name = name; ptype_loc = loc; _
+        } ->
+          begin try
+            let (file, path, x) = this # source name.txt arg in
+            {((from_file file) # tydecl path x)
+            with ptype_name = name; ptype_loc = loc}
+          with exn -> fatal loc exn
+          end
+      | td -> td
+
+    method! mtydecl = function
+      | {pmtd_type = Some{pmty_desc=Pmty_extension({txt="copy_typedef";_}, arg);
+                          pmty_loc=loc; _};
+         pmtd_name = name; _
+        } ->
+          begin try
+            let (file, path, x) = this # source name.txt arg in
+            {((from_file file) # mtydecl path x)
+            with pmtd_name = name}
+          with exn -> fatal loc exn
+          end
+      | td -> td
+
+    method! implementation f x =
+      file <- f;
+      super # implementation f x
+
+    method! interface f x =
+      file <- f;
+      super # interface f x
+  end
+
+  let () = Ast_mapper.main copy
+end
diff --git a/experimental/frisch/dumpast.ml b/experimental/frisch/dumpast.ml
new file mode 100644
index 000000000..1ab6ecf06
--- /dev/null
+++ b/experimental/frisch/dumpast.ml
@@ -0,0 +1,51 @@
+(* Illustrate how to use AST lifting to create a pretty-printer *)
+
+open Outcometree
+
+class out_value_builder =
+  object
+    method record (_ty : string) x = Oval_record (List.map (fun (l, s) -> (Oide_ident l, s)) x)
+    method constr (_ty : string) (c, args) = Oval_constr (Oide_ident c, args)
+    method list x = Oval_list x
+    method array x = Oval_list (Array.to_list x)
+    method tuple x = Oval_tuple x
+    method int x = Oval_int x
+    method string x = Oval_string x
+    method char x = Oval_char x
+    method int32 x = Oval_int32 x
+    method int64 x = Oval_int64 x
+    method nativeint x = Oval_nativeint x
+  end
+
+let lift =
+  object
+    inherit [_] Ast_lifter.lifter
+    inherit out_value_builder
+    method! lift_Location_t _ = Oval_ellipsis
+        (* Special mapping for the Location.t type *)
+  end
+
+let show lifter parse s =
+  let v = lifter (parse (Lexing.from_string s)) in
+  Format.printf "%s@.==>@.%a@.=========@." s !Oprint.out_value v
+
+let show_expr = show (lift # lift_Parsetree_expression) Parse.expression
+let show_pat = show (lift # lift_Parsetree_pattern) Parse.pattern
+
+let args =
+  let open Arg in
+  [
+   "-e", String show_expr,
+   "<expr> Dump AST for expression <expr>.";
+
+   "-p", String show_pat,
+   "<pat> Dump AST for pattern <pat>."
+  ]
+
+let usage =
+  Printf.sprintf "%s [options]\n" Sys.argv.(0)
+
+let () =
+  Arg.parse (Arg.align args) show_expr usage
+
+
diff --git a/experimental/frisch/eval.ml b/experimental/frisch/eval.ml
new file mode 100644
index 000000000..dcdb5b553
--- /dev/null
+++ b/experimental/frisch/eval.ml
@@ -0,0 +1,142 @@
+(* A -ppx rewriter which evaluates expressions at compile-time,
+   using the OCaml toplevel interpreter.
+
+   The following extensions are supported:
+
+   [%eval e] in expression context: the expression e will be evaluated
+   at compile time, and the resulting value will be inserted as a
+   constant literal.
+
+   [%%eval.start] as a structure item: forthcoming structure items
+   until the next [%%eval.stop] will be evaluated at compile time (the
+   result is ignored) only.
+
+   [%%eval.start both] as a structure item: forthcoming structure
+   items until the next [%%eval.stop] will be evaluated at compile
+   time (the result is ignored), but also kept in the compiled unit.
+
+   [%%eval.load "..."] as a structure item: load the specified
+   .cmo unit or .cma library, so that it can be used in the forthcoming
+   compile-time components.
+*)
+
+
+module Main : sig end = struct
+
+  open Location
+  open Parsetree
+  open Ast_helper
+  open Outcometree
+  open Ast_helper.Convenience
+
+  let rec lid_of_out_ident = function
+    | Oide_apply _ -> assert false
+    | Oide_dot (x, s) -> lid_of_out_ident x ^ "." ^ s
+    | Oide_ident s -> s
+
+  let rec exp_of_out_value = function
+    | Oval_string x -> str x
+    | Oval_int x -> int x
+    | Oval_char x -> char x
+    | Oval_float x -> Ast_helper.Convenience.float x
+    | Oval_list l -> list (List.map exp_of_out_value l)
+    | Oval_array l -> Exp.array (List.map exp_of_out_value l)
+    | Oval_constr (c, args) -> constr (lid_of_out_ident c) (List.map exp_of_out_value args)
+    | Oval_record l ->
+        record
+          (List.map
+             (fun (s, v) -> lid_of_out_ident s, exp_of_out_value v) l)
+    | v ->
+        Format.eprintf "[%%eval] cannot map value to expression:@.%a@."
+          !Toploop.print_out_value
+          v;
+        exit 2
+
+  let empty_str_item = Str.include_ (Mod.structure [])
+
+  let run phr =
+    try Toploop.execute_phrase true Format.err_formatter phr
+    with exn ->
+      Errors.report_error Format.err_formatter exn;
+      exit 2
+
+  let get_exp loc = function
+    | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
+    | _ ->
+        Format.eprintf "%aExpression expected@."
+          Location.print_error loc;
+        exit 2
+
+  let eval = object
+    inherit Ast_mapper.mapper as super
+
+    val mutable eval_str_items = None
+
+    method! structure_item i =
+      match i.pstr_desc with
+      | Pstr_extension(({txt="eval.load";loc}, e0), _) ->
+          let e0 = get_exp loc e0 in
+          let s =
+            match get_str e0 with
+            | Some s -> s
+            | None ->
+                Location.print_error Format.err_formatter e0.pexp_loc;
+                Format.eprintf "string literal expected";
+                exit 2
+          in
+          if not (Topdirs.load_file Format.err_formatter s) then begin
+            Location.print Format.err_formatter e0.pexp_loc;
+            exit 2;
+          end;
+          empty_str_item
+      | Pstr_extension(({txt="eval.start";_},
+                        PStr [{pstr_desc=Pstr_eval (e, _);_}]
+                       ), _) when get_lid e = Some "both" ->
+          eval_str_items <- Some true;
+          empty_str_item
+      | Pstr_extension(({txt="eval.start";_}, PStr []), _) ->
+          eval_str_items <- Some false;
+          empty_str_item
+      | Pstr_extension(({txt="eval.stop";_}, PStr []), _) ->
+          eval_str_items <- None;
+          empty_str_item
+      | _ ->
+          let s = super # structure_item i in
+          match eval_str_items with
+          | None -> s
+          | Some both ->
+              if not (run (Ptop_def [s])) then begin
+                Location.print_error Format.err_formatter s.pstr_loc;
+                Format.eprintf "this structure item raised an exception@.";
+                exit 2
+              end;
+              if both then s else empty_str_item
+
+    method! expr e =
+      match e.pexp_desc with
+      | Pexp_extension({txt="eval";loc}, e0) ->
+          let e0 = get_exp loc e0 in
+          let last_result = ref None in
+          let pop = !Toploop.print_out_phrase in
+          Toploop.print_out_phrase := begin fun _ppf -> function
+            | Ophr_eval (v, _) -> last_result := Some v
+            | r ->
+                Location.print_error Format.err_formatter e.pexp_loc;
+                Format.eprintf "error while evaluating expression:@.%a@."
+                  pop
+                  r;
+                exit 2
+          end;
+          assert (run (Ptop_def [Str.eval e0]));
+          Toploop.print_out_phrase := pop;
+          let v = match !last_result with None -> assert false | Some v -> v in
+          with_default_loc e0.pexp_loc (fun () -> exp_of_out_value v)
+      | _ ->
+          super # expr e
+
+    initializer Toploop.initialize_toplevel_env ()
+  end
+
+
+  let () = Ast_mapper.main eval
+end
diff --git a/experimental/frisch/extension_points.txt b/experimental/frisch/extension_points.txt
new file mode 100644
index 000000000..7d87a06ac
--- /dev/null
+++ b/experimental/frisch/extension_points.txt
@@ -0,0 +1,722 @@
+This file describes the changes on the extension_points branch.
+
+
+=== Attributes
+
+Attributes are "decorations" of the syntax tree which are ignored by
+the type-checker.  An attribute is made of an identifier (written id below)
+and a payload (written s below).
+
+ * The identifier 'id' can be a lowercase or uppercase identifier
+   (including OCaml keywords) or a sequence of such atomic identifiers
+   separated with a dots (whitespaces are allowed around the dots).
+   In the Parsetree, the identifier is represented as a single string
+   (without spaces).
+
+ * The payload 's' can be one of three things:
+
+   - An OCaml structure (i.e. a list of structure items).  Note that a
+     structure can be empty or reduced to a single expression.
+
+        [@id]
+        [@id x + 3]
+        [@id type t = int]
+
+   - A type expression, prefixed with the ":" character.
+
+        [@id : TYP]
+
+   - A pattern, prefixed with the "?" character, and optionally followed
+     by a "when" clause:
+
+        [@id ? PAT]
+        [@id ? PAT when EXPR]
+
+
+Attributes on expressions, type expressions, module expressions, module type expressions,
+patterns, class expressions, class type expressions:
+ 
+  ... [@id s]
+
+The same syntax [@id s] is also available to add attributes on
+constructors and labels in type declarations:
+
+  type t =
+    | A [@id1]
+    | B [@id2] of int [@id3]
+
+Here, id1 (resp. id2) is attached to the constructor A (resp. B)
+and id3 is attached to the int type expression.  Example on records:
+
+ type t =
+   {
+      x [@id1]: int;
+      mutable y [@id2] [@id3]: string [@id4];
+   }  
+
+
+Attributes on items:
+
+  ... [@@id s]
+
+  Items designate:
+    - structure and signature items (for type declarations, recursive modules, class
+  declarations and class type declarations, each component has its own attributes)
+    - class fields and class type fields
+    - each binding in a let declaration (for let structure item, local let-bindings in 
+      expression and class expressions)
+
+  For instance, consider:
+
+    type t1 = ... [@@id1] [@@id2] and t2 = ... [@@id3] [@@id4]
+
+  Here, the attributes on t1 are id1, id23; the attributes on
+  t2 are id3 and id4.
+
+  Similarly for:
+
+    let x1 = ... [@@id1] [@@id2] and x2 = ... [@@id3] [@@id4]
+
+
+  The [@@id s] form, when used at the beginning of a signature or
+  structure, or after a double semi-colon (;;), defines an attribute
+  which stands as a stand-alone signature or structure item (not
+  attached to another item).
+
+  Example:
+
+  module type S = sig
+    [@@id1]
+    type t
+    [@@id2]
+    ;; [@@id3] [@@id4]
+    ;; [@@id5]
+    type s
+    [@@id6]
+  end
+
+  Here, id1, id3, id4, id5 are stand-alone attributes, while
+  id2 is attached to the type t and id6 is attached to the type s.
+
+=== Extension nodes
+
+Extension nodes replace valid components in the syntax tree.  They are
+normally interpreted and expanded by AST mapper.  The type-checker
+fails when it encounters such an extension node.  An extension node is
+made of an identifier (an "LIDENT", written id below) and an optional
+expression (written expr below).
+
+Two syntaxes exist for extension node:
+
+As expressions, type expressions, module expressions, module type expressions,
+patterns, class expressions, class type expressions:
+
+  [%id s]
+
+As structure item, signature item, class field, class type field:
+ 
+  [%%id s]
+
+As other structure item, signature item, class field or class type
+field, attributes can be attached to a [%%id s] extension node.
+
+
+=== Alternative syntax for attributes and extensions on specific kinds of nodes
+
+All expression constructions starting with a keyword (EXPR = KW REST) support an
+alternative syntax for attributes and/or extensions:
+
+  KW[@id s]...[@id s] REST
+  ---->
+  EXPR[@id s]...[@id s]
+
+  KW%id REST
+  ---->
+  [%id EXPR]
+
+  KW%id[@id s]...[@id s] REST
+  ---->
+  [%id EXPR[@id s]...[@id s]]
+
+
+where KW can stand for:
+ assert
+ begin
+ for
+ fun
+ function
+ if
+ lazy
+ let
+ let module
+ let open
+ match
+ new
+ object
+ try
+ while
+
+
+For instance:
+
+let[@foo] x = 2 in x + 1   ====   (let x = 2 in x + 1)[@foo]
+begin[@foo] ... end        ====   (begin ... end)[@foo]
+match%foo e with ...       ====   [%foo match e with ...]
+
+
+=== Quoted strings
+
+Quoted strings gives a different syntax to write string literals in
+OCaml code.  This will typically be used to support embedding pieces
+of foreign syntax fragments (to be interpret by a -ppx filter or just
+a library) in OCaml code.
+
+The opening delimiter has the form {id| where id is a (possibly empty)
+sequence of lowercase letters.  The corresponding closing delimiter is
+|id} (the same identifier).  Contrary to regular OCaml string
+literals, quoted strings don't interpret any character in a special
+way.
+
+Example:
+
+String.length {|\"|}   (* returns 2 *)
+String.length {foo|\"|foo}   (* returns 2 *)
+
+
+The fact that a string literal comes from a quoted string is kept in
+the Parsetree representation.  The Astypes.Const_string constructor is
+now defined as:
+
+  | Const_string of string * string option
+
+where the "string option" represents the delimiter (None for a string
+literal with the regular syntax).
+
+
+=== Representation of attributes in the Parsetree
+
+Attributes as standalone signature/structure items are represented
+by a new constructor:
+
+  | Psig_attribute of attribute
+  | Pstr_attribute of attribute
+
+Most other attributes are stored in an extra field in their record:
+
+and expression =  {
+  ...
+  pexp_attributes: attribute list;
+  ...
+}
+and type_declaration = {
+  ...
+  ptype_attributes: attribute list;
+  ...
+}
+
+In a previous version, attributes on expressions (and types, patterns,
+etc) used to be stored as a new constructor.  The current choice makes
+it easier to pattern match on structured AST fragments while ignoring
+attributes.
+
+For open/include signature/structure items and exception rebind
+structure item, the attributes are stored directly in the constructor
+of the item:
+
+  | Pstr_open of Longident.t loc * attribute list
+
+
+=== Attributes in the Typedtree
+
+The Typedtree representation has been updated to follow closely the
+Parsetree, and attributes are kept exactly as in the Parsetree.  This
+can allow external tools to process .cmt/.cmti files and process
+attributes in them.  An example of a mini-ocamldoc based on this
+technique is in experimental/frisch/minidoc.ml.
+
+
+=== Other changes to the parser and Parsetree
+
+--- Introducing Ast_helper module
+
+This module simplifies the creation of AST fragments, without having to
+touch the concrete type definitions of Parsetree. Record and sum types
+are encapsulated in builder functions, with some optional arguments, e.g.
+to represent attributes.
+
+--- Relaxing the syntax for signatures and structures
+
+It is now possible to start a signature or a structure with a ";;" token and to have two successive ";;" tokens.
+
+Rationale:
+   It makes it possible to always prefix a "standalone" attribute by ";;" independently
+   from its context (this will work at the beginning of the signature/structure and after
+   another item finished with ";;").
+
+-- Relaxing the syntax for exception declarations
+
+The parser now accepts the same syntax for exceptioon declarations as for constructor declarations,
+which permits the GADT syntax:
+
+ exception A : int -> foo
+
+The type-checker rejects this form.  Note that it is also possible to
+define exception whose name is () or ::.
+
+Attributes can be put on the constructor or on the whole declaration:
+
+ exception A[@foo] of int [@@bar]
+
+Rationale:
+  One less notion in the Parsetree, more uniform parsing.  Also
+  open the door to existentials in exception constructors.
+
+--- Relaxing the syntax for recursive modules
+
+Before:
+   module X1 : MT1 = M1 and ... and Xn : MTn = Mn
+
+Now:
+   module X1 = M1 and ... and Xn = Mn
+   (with the usual sugar that Xi = (Mi : MTi) can be written as Xi : MTi = Mi
+   which gives the old syntax)
+
+   The type-checker fails when a module expression is not of
+   the form (M : MT)
+   
+
+Rationale:
+
+1. More uniform representation in the Parsetree.
+
+2. The type-checker can be made more clever in the future to support
+   other forms of module expressions (e.g. functions with an explicit
+   constraint on its result; or a structure with only type-level
+   components).
+    
+      
+--- Turning some tuple or n-ary constructors into records
+
+Before:
+
+  | Pstr_module of string loc * module_expr
+
+After:
+
+  | Pstr_module of module_binding
+...
+  and module_binding =
+    {
+     pmb_name: string loc;
+     pmb_expr: module_expr;
+     pmb_attributes: attribute list;
+    }
+
+
+
+Rationale:
+
+More self-documented, more robust to future additions (such as
+attributes), simplifies some code.
+
+
+--- Keeping names inside value_description and type_declaration
+
+Before:
+
+  | Psig_type of (string loc * type_declaration) list
+
+
+After:
+
+  | Psig_type of type_declaration list
+
+....
+and type_declaration =
+  { ptype_name: string loc;
+    ...
+  }
+
+Rationale:
+
+More self-documented, simplifies some code.
+
+
+--- Better representation of variance information on type parameters
+
+Introduced a new type Asttypes.variance to represent variance
+(Covariant/Contravariant/Invariant) and use it instead of bool * bool
+in Parsetree.  Moreover, variance information is now attached
+directly to the parameters fields:
+
+ and type_declaration =
+   { ptype_name: string loc;
+-    ptype_params: string loc option list;
++    ptype_params: (string loc option * variance) list;
+     ptype_cstrs: (core_type * core_type * Location.t) list;
+     ptype_kind: type_kind;
+     ptype_private: private_flag;
+     ptype_manifest: core_type option;
+-    ptype_variance: (bool * bool) list;
+     ptype_attributes: attribute list;
+     ptype_loc: Location.t }
+
+
+--- Getting rid of 'Default' case in Astypes.rec_flag
+
+This constructor was used internally only during the compilation of
+default expression for optional arguments, in order to trigger a
+subsequent optimization (see PR#5975).  This behavior is now
+implemented by creating an attribute internally (whose name "#default"
+cannot be used in real programs).
+
+Rationale:
+
+ - Attributes give a way to encode information local to the
+   type-checker without polluting the definition of the Parsetree.
+
+--- Simpler and more faithful representation of object types
+
+-  | Ptyp_object of core_field_type list
++  | Ptyp_object of (string * core_type) list * closed_flag
+
+(and get rid of Parsetree.core_field_type)
+
+And same in the Typedtree.
+
+Rationale:
+
+ - More faithful representation of the syntax really supported
+   (i.e. the ".." can only be the last field).
+ - One less "concept" in the Parsetree.
+
+
+--- Do not require empty Ptyp_poly nodes in the Parsetree
+
+The type-checker automatically inserts Ptyp_poly node (with no
+variable) where needed.  It is still allowed to put empty
+Ptyp_poly nodes in the Parsetree. 
+
+Rationale:
+
+ - Less chance that Ast-related code forget to insert those nodes.
+
+To be discussed: should we segrate simple_poly_type from core_type in the
+Parsetree to prevent Ptyp_poly nodes to be inserted in the wrong place?
+
+
+--- Use constructor names closer to concrete syntax
+
+E.g. Pcf_cstr -> Pcf_constraint.
+
+Rationale:
+
+ - Make the Parsetree more self-documented.
+
+--- Merge concrete/virtual val and method constructors
+
+As in the Typedtree.
+
+-  | Pcf_valvirt of (string loc * mutable_flag * core_type)
+-  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
+-  | Pcf_virt of (string loc * private_flag * core_type)
+-  | Pcf_meth of (string loc * private_flag * override_flag * expression)
++  | Pcf_val of (string loc * mutable_flag * class_field_kind)
++  | Pcf_method of (string loc * private_flag * class_field_kind
+...
++and class_field_kind =
++  | Cfk_virtual of core_type
++  | Cfk_concrete of override_flag * expression
++
+
+--- Explicit representation of "when" guards
+
+Replaced the "(pattern * expression) list" argument of Pexp_function, Pexp_match, Pexp_try 
+with "case list", with case defined as:
+
+  {
+   pc_lhs: pattern;
+   pc_guard: expression option;
+   pc_rhs: expression;
+  }
+
+and get rid of Pexp_when. Idem in the Typedtree.
+
+Rationale:
+
+  - Make it explicit when the guard can appear.
+
+--- Get rid of "fun p when guard -> e"
+
+See #5939, #5936.
+
+
+--- Get rid of the location argument on pci_params
+
+It was only used for error messages, and we get better location using
+the location of each parameter variable.
+
+--- More faithful representation of "with constraint"
+
+All kinds of "with constraints" used to be represented together with a
+Longident.t denoting the constrained identifier.  Now, each constraint
+keeps its own constrainted identifier, which allows us to express more
+invariants in the Parsetree (such as: := constraints cannot be on qualified
+identifiers).  Also, we avoid mixing in a single Longident.t identifier
+which can be LIDENT or UIDENT.
+
+--- Get rid of the "#c [> `A]" syntax
+
+See #5936, #5983.
+
+--- Keep interval patterns in the Parsetree
+
+They used to be expanded into or-patterns by the parser.  It is better to do
+the expansion in the type-checker to allow -ppx rewriters to see the interval
+patterns.
+
+Note: Camlp4 parsers still expand interval patterns themselves (TODO?).
+
+--- Get rid of Pexp_assertfalse
+
+Do not treat specially "assert false" in the parser any more, but
+instead in the type-checker.  This simplifies the Parsetree and avoids
+a potential source of confusion.  Moreove, this ensures that
+attributes can be put (and used by ppx rewriters) on the "false"
+expressions.  This is also more robust, since it checks that the
+condition is the constructor "false" after type-checking the condition:
+
+ - if "false" is redefined (as a constructor of a different sum type),
+   an error will be reported;
+
+ - "extra" layers which are represented as exp_extra in the typedtree
+   won't break the detection of the "false", e.g. the following will
+   be recognized as "assert false":
+
+     assert(false : bool)
+     assert(let open X in false)
+
+Note: Camlp4's AST still has a special representation for "assert false".
+
+--- Get rid of the "explicit arity" flag on Pexp_construct/Ppat_construct
+
+This Boolean was used (only by camlp5?) to indicate that the tuple
+(expression/pattern) used as the argument was intended to correspond
+to the arity of an n-ary constructor.  In particular, this allowed
+the revised syntax to distinguish "A x y" from "A (x, y)" (the second one
+being wrapped in an extra fake tuple) and get a proper error message
+if "A (x, y)" was used with a constructor expecting two arguments.
+
+If really required, the same feature could be restored by storing the
+flag as an attribute (with very light support in the type-checker), in
+order to avoid polluting the official Parsetree.
+
+--- Split Pexp_function into Pexp_function/Pexp_fun
+
+This reflects more closely the concrete syntax and removes cases of
+Parsetree fragments which don't correspond to concrete syntax.
+
+Typedtree has not been changed.
+
+Note: Camlp4's AST has not been adapted.
+
+--- Split Pexp_constraint into Pexp_constraint/Pexp_coerce
+
+Idem in the Typedtree.
+
+This reflects more closely the concrete syntax.
+
+Note: Camlp4's AST has not been adapted.
+
+--- Accept abstract module type declaration in structures
+
+Previously, we could declare:
+
+ module type S
+
+in signatures, but not implementations.  To make the syntax, the Parsetree
+and the type-checker more uniform, this is now also allowed in structures
+(altough this is probably useless in practice).
+
+=== More TODOs
+
+- Adapt pprintast to print attributes and extension nodes.
+- Adapt Camlp4 (both its parser(s) and its internal representation of OCaml ASTs).
+- Consider adding hooks to the type-checker so that custom extension expanders can be registered (a la OCaml Templates).
+- Make the Ast_helper module more user-friendly (e.g. with optional arguments and good default values) and/or
+  expose higher-level convenience functions.
+- Document Ast_helper modules.
+
+=== Use cases
+
+From https://github.com/gasche/ocaml-syntax-extension-discussion/wiki/Use-Cases
+
+-- Bisect
+
+  let f x =
+  match List.map foo [x; a x; b x] with
+  | [y1; y2; y3] -> tata
+  | _ -> assert false [@bisect VISIT]
+
+;;[@@bisect IGNORE-BEGIN]
+let unused = ()
+;;[@@bisect IGNORE-END]
+
+-- OCamldoc
+
+val stats : ('a, 'b) t -> statistics
+[@@doc
+ "[Hashtbl.stats tbl] returns statistics about the table [tbl]:
+  number of buckets, size of the biggest bucket, distribution of
+  buckets by size."
+]
+[@@since "4.00.0"]
+
+;;[@@doc section 6 "Functorial interface"]
+
+module type HashedType =
+  sig
+    type t
+      [@@doc "The type of the hashtable keys."]
+    val equal : t -> t -> bool
+      [@@doc "The equality predicate used to compare keys."]
+  end
+
+
+-- type-conv, deriving
+
+type t = {
+  x : int [@default 42];
+  y : int [@default 3] [@sexp_drop_default];
+  z : int [@default 3] [@sexp_drop_if z_test];
+} [@@sexp]
+
+
+type r1 = {
+  r1_l1 : int;
+  r1_l2 : int;
+} [@@deriving (Dump, Eq, Show, Typeable, Pickle, Functor)]
+
+-- camlp4 map/fold generators
+
+type variable = string
+ and term =
+  | Var of variable
+  | Lam of variable * term
+  | App of term * term
+
+
+class map = [%generate_map term]
+or:
+[%%generate_map map term]
+
+
+-- ocaml-rpc
+
+type t = { foo [@rpc "type"]: int; bar [@rpc "let"]: int }
+[@@ rpc]
+
+or:
+
+type t = { foo: int; bar: int }
+[@@ rpc ("foo" > "type"), ("bar" > "let")]
+
+
+
+-- pa_monad
+
+begin%monad
+  a <-- [1; 2; 3];
+  b <-- [3; 4; 5];
+  return (a + b)
+end
+
+-- pa_lwt
+
+let%lwt x = start_thread foo
+and y = start_other_thread foo in
+try%lwt
+  let%for_lwt (x, y) = waiting_threads in
+  compute blah
+with Killed -> bar
+
+-- Bolt
+
+let funct n =
+  [%log "funct(%d)" n LEVEL DEBUG];
+  for i = 1 to n do
+    print_endline "..."
+  done
+
+
+-- pre-polyrecord
+
+let r = [%polyrec x = 1; y = ref None]
+let () = [%polyrec r.y <- Some 2]
+
+-- orakuda
+
+function%regexp
+  | "$/^[0-9]+$/" as v -> `Int (int_of_string v#_0)
+  | "$/^[a-z][A-Za-z0-9_]*$" as v -> `Variable v#_0
+  | _ -> failwith "parse error"
+
+-- bitstring
+
+let bits = Bitstring.bitstring_of_file "/bin/ls" in
+match%bitstring bits with
+| [ 0x7f, 8; "ELF", 24, string;  (* ELF magic number *)
+    e_ident, Mul(12,8), bitstring;    (* ELF identifier *)
+    e_type, 16, littleendian;    (* object file type *)
+    e_machine, 16, littleendian  (* architecture *)
+  ] ->
+  printf "This is an ELF binary, type %d, arch %d\n"
+    e_type e_machine
+
+-- sedlex
+
+let rec token buf =
+  let%regexp ('a'..'z'|'A'..'Z') = letter in
+  match%sedlex buf with
+  | number -> Printf.printf "Number %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+  | letter, Star ('A'..'Z' | 'a'..'z' | digit) -> Printf.printf "Ident %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+  | Plus xml_blank -> token buf
+  | Plus (Chars "+*-/") -> Printf.printf "Op %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+  | Range(128,255) -> print_endline "Non ASCII"
+  | eof -> print_endline "EOF"
+  | _ -> failwith "Unexpected character"
+
+
+-- cppo
+
+[%%ifdef DEBUG]
+[%%define debug(s) = Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s]
+[%%else]
+[%%define debug(s) = ()]
+[%%endif]
+
+debug("test")
+
+
+-- PG'OCaml
+
+let fetch_users dbh =
+  [%pgsql dbh "select id, name from users"]
+
+
+-- Macaque
+
+let names view = [%view {name = t.name}, t <- !view]" 
+
+
+-- Cass
+
+let color1 = [%css{| black |}]
+let color2 = [%css{| gray |}]
+ 
+let button = [%css{|
+   .button {
+     $Css.gradient ~low:color2 ~high:color1$;
+     color: white;
+     $Css.top_rounded$;
+ |}]
diff --git a/experimental/frisch/genlifter.ml b/experimental/frisch/genlifter.ml
new file mode 100644
index 000000000..d39066eaa
--- /dev/null
+++ b/experimental/frisch/genlifter.ml
@@ -0,0 +1,174 @@
+(* Generate code to lift values of a certain type.
+   This illustrates how to build fragments of Parsetree through
+   Ast_helper and more local helper functions. *)
+
+module Main : sig end = struct
+
+open Location
+open Types
+open Asttypes
+open Ast_helper
+open Ast_helper.Convenience
+
+let selfcall ?(this = "this") m args = app (Exp.send (evar this) m) args
+
+(*************************************************************************)
+
+
+let env = Env.initial
+
+let clean s =
+  let s = String.copy s in
+  for i = 0 to String.length s - 1 do
+    if s.[i] = '.' then s.[i] <- '_'
+  done;
+  s
+
+let print_fun s = "lift_" ^ clean s
+
+let printed = Hashtbl.create 16
+let meths = ref []
+
+let rec gen ty =
+  if Hashtbl.mem printed ty then ()
+  else let tylid = Longident.parse ty in
+  let (_, td) =
+    try Env.lookup_type tylid env
+    with Not_found ->
+      Format.eprintf "** Cannot resolve type %s" ty;
+      exit 2
+  in
+  let prefix =
+    let open Longident in
+    match tylid with
+    | Ldot (m, _) -> String.concat "." (Longident.flatten m) ^ "."
+    | Lident _ -> ""
+    | Lapply _ -> assert false
+  in
+  Hashtbl.add printed ty ();
+  let params = List.mapi (fun i _ -> Printf.sprintf "f%i" i) td.type_params in
+  let env = List.map2 (fun s t -> t.id, evar s) params td.type_params in
+  let tyargs = List.map Typ.var params in
+  let t = Typ.(arrow "" (constr (lid ty) tyargs) (var "res")) in
+  let t =
+    List.fold_right
+      (fun s t ->
+        Typ.(arrow "" (arrow "" (var s) (var "res")) t))
+      params t
+  in
+  let t = Typ.poly params t in
+  let concrete e =
+    let e = List.fold_right lam (List.map pvar params) e in
+    let body = Exp.poly e (Some t) in
+    meths := Cf.(method_ (mknoloc (print_fun ty)) Public (concrete Fresh body)) :: !meths
+  in
+  match td.type_kind, td.type_manifest with
+  | Type_record (l, _), _ ->
+      let field (s, _, t) =
+        let s = Ident.name s in
+        (lid (prefix ^ s), pvar s),
+        tuple[str s; tyexpr env t (evar s)]
+      in
+      let l = List.map field l in
+      concrete
+        (lam
+           (Pat.record (List.map fst l) Closed)
+           (selfcall "record" [str ty; list (List.map snd l)]))
+  | Type_variant l, _ ->
+      let case (c, tyl, _) =
+        let c = Ident.name c in
+        let qc = prefix ^ c in
+        let p, args = gentuple env tyl in
+        pconstr qc p, selfcall "constr" [str ty; tuple[str c; list args]]
+      in
+      concrete (func (List.map case l))
+  | Type_abstract, Some t ->
+      concrete (tyexpr_fun env t)
+  | Type_abstract, None ->
+      (* Generate an abstract method to lift abstract types *)
+      meths := Cf.(method_ (mknoloc (print_fun ty)) Public (virtual_ t)) :: !meths
+
+and gentuple env tl =
+  let arg i t =
+    let x = Printf.sprintf "x%i" i in
+    pvar x, tyexpr env t (evar x)
+  in
+  List.split (List.mapi arg tl)
+
+and tyexpr env ty x =
+  match ty.desc with
+  | Tvar _ ->
+      let f =
+        try List.assoc ty.id env
+        with Not_found -> assert false
+      in
+      app f [x]
+  | Ttuple tl ->
+      let p, e = gentuple env tl in
+      let_in [Vb.mk (Pat.tuple p) x] (selfcall "tuple" [list e])
+  | Tconstr (path, [t], _) when Path.same path Predef.path_list ->
+      selfcall "list" [app (evar "List.map") [tyexpr_fun env t; x]]
+  | Tconstr (path, [t], _) when Path.same path Predef.path_array ->
+      selfcall "array" [app (evar "Array.map") [tyexpr_fun env t; x]]
+  | Tconstr (path, [], _) when Path.same path Predef.path_string ->
+      selfcall "string" [x]
+  | Tconstr (path, [], _) when Path.same path Predef.path_int ->
+      selfcall "int" [x]
+  | Tconstr (path, [], _) when Path.same path Predef.path_char ->
+      selfcall "char" [x]
+  | Tconstr (path, [], _) when Path.same path Predef.path_int32 ->
+      selfcall "int32" [x]
+  | Tconstr (path, [], _) when Path.same path Predef.path_int64 ->
+      selfcall "int64" [x]
+  | Tconstr (path, [], _) when Path.same path Predef.path_nativeint ->
+      selfcall "nativeint" [x]
+  | Tconstr (path, tl, _) ->
+      let ty = Path.name path in
+      gen ty;
+      selfcall (print_fun ty) (List.map (tyexpr_fun env) tl @ [x])
+  | _ ->
+      Format.eprintf "** Cannot deal with type %a@." Printtyp.type_expr ty;
+      exit 2
+
+and tyexpr_fun env ty =
+  lam (pvar "x") (tyexpr env ty (evar "x"))
+
+let simplify =
+  object
+    inherit Ast_mapper.mapper as super
+    method! expr e =
+      let e = super # expr e in
+      let open Longident in
+      let open Parsetree in
+      match e.pexp_desc with
+      | Pexp_fun
+          ("", None,
+           {ppat_desc = Ppat_var{txt=id;_};_},
+           {pexp_desc =
+            Pexp_apply
+              (f,
+               ["",{pexp_desc=
+                    Pexp_ident{txt=Lident id2;_};_}]);_}) when id = id2 -> f
+      | _ -> e
+  end
+
+let args =
+  let open Arg in
+  [
+   "-I", String (fun s -> Config.load_path := s :: !Config.load_path),
+   "<dir> Add <dir> to the list of include directories";
+  ]
+
+let usage =
+  Printf.sprintf "%s [options] <type names>\n" Sys.argv.(0)
+
+let () =
+  Config.load_path := [];
+  Arg.parse (Arg.align args) gen usage;
+  let cl = {Parsetree.pcstr_self = pvar "this"; pcstr_fields = !meths} in
+  let params = [mknoloc "res", Invariant] in
+  let cl = Ci.mk ~virt:Virtual ~params (mknoloc "lifter") (Cl.structure cl) in
+  let s = [Str.class_ [cl]] in
+  Format.printf "%a@." Pprintast.structure (simplify # structure s)
+
+end
diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml
index 944d1feb9..e4396202a 100644
--- a/experimental/frisch/ifdef.ml
+++ b/experimental/frisch/ifdef.ml
@@ -1,58 +1,103 @@
-(* This filter implements the following rewriting on module expressions:
+(* This filter implements the following extensions:
 
-   IFDEF(X)(<m1>)(<m2>)
-               ---> <m1>      if the environment variable X is defined
-               ---> <m2>      otherwise
+   In structures:
 
-   And, on expressions:
+   [%%IFDEF X]
+   ...             --> included if the environment variable X is defined
+   [%%ELSE]
+   ...             --> included if the environment variable X is undefined
+   [%%END]
 
-   GETENV X    ---> the string literal representing the compile-time value
+
+   In expressions:
+
+   [%GETENV X]    ---> the string literal representing the compile-time value
                     of environment variable X
+
+
+   In variant type declarations:
+
+   type t =
+      ..
+     | C [@IFDEF X] of ...   --> the constructor is kept only if X is defined
+
+
+   In match clauses (function/match...with/try...with):
+
+
+   P when [%IFDEF X] -> E    --> the case is kept only if X is defined
+
 *)
 
-open Ast_mapper
+open Location
+open Ast_helper
+open! Asttypes
 open Parsetree
 open Longident
-open Location
 
-let getenv s = try Sys.getenv s with Not_found -> ""
+let getenv loc arg =
+  match arg with
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc = Pexp_construct ({txt = Lident sym; _}, None); _}, _); _}] ->
+      (try Sys.getenv sym with Not_found -> "")
+  | _ ->
+      Format.eprintf "%a** IFDEF: bad syntax."
+        Location.print_error loc;
+      exit 2
+
+let empty_str_item = Str.include_ (Mod.structure [])
 
 let ifdef =
   object(this)
-    inherit Ast_mapper.create as super
-
-    method! module_expr = function
-      | {pmod_desc = Pmod_apply(
-         {pmod_desc = Pmod_apply(
-          {pmod_desc = Pmod_apply(
-           {pmod_desc = Pmod_ident {txt = Lident "IFDEF"}},
-           {pmod_desc = Pmod_ident {txt = Lident sym}}
-          )},
-          body_def)},
-         body_not_def)} ->
-           if getenv sym <> "" then
-             this # module_expr body_def
-           else
-             this # module_expr body_not_def
-
-      | {pmod_desc = Pmod_ident {txt = Lident "IFDEF"}; pmod_loc = loc} ->
-          Format.printf "%a@.Improper use of IFDEF. The correct form is: IFDEF(<var_name:uident>)(<then:modtype>)(<body:modtype>)@."
-            Location.print_loc loc;
+    inherit Ast_mapper.mapper as super
+
+    val mutable stack = []
+
+    method eval_attributes =
+      List.for_all
+        (function
+          | {txt="IFDEF"; loc}, arg -> getenv loc arg <> ""
+          | {txt="IFNDEF"; loc}, arg -> getenv loc arg = ""
+          | _ -> true)
+
+    method filter_constr cd = this # eval_attributes cd.pcd_attributes
+
+    method! type_declaration = function
+      | {ptype_kind = Ptype_variant cstrs; _} as td ->
+          {td with ptype_kind =
+           Ptype_variant(List.filter (this # filter_constr) cstrs)}
+      | td -> td
+
+    method! cases l =
+      List.fold_right
+        (fun c rest ->
+          match c with
+          | {pc_guard=Some {pexp_desc=Pexp_extension({txt="IFDEF";loc}, arg); _}; _} ->
+              if getenv loc arg = "" then rest else {c with pc_guard=None} :: rest
+          | c -> c :: rest
+        ) l []
+
+    method! structure_item i =
+      match i.pstr_desc, stack with
+      | Pstr_extension(({txt="IFDEF";loc}, arg), _), _ ->
+          stack <- (getenv loc arg <> "") :: stack;
+          empty_str_item
+      | Pstr_extension(({txt="ELSE";loc=_}, _), _), (hd :: tl) ->
+          stack <- not hd :: tl;
+          empty_str_item
+      | Pstr_extension(({txt="END";loc=_}, _), _), _ :: tl ->
+          stack <- tl;
+          empty_str_item
+      | Pstr_extension(({txt="ELSE"|"END";loc}, _), _), [] ->
+          Format.printf "%a** IFDEF: mo matching [%%%%IFDEF]"
+            Location.print_error loc;
           exit 2
-      | x -> super # module_expr x
+      | _, (true :: _ | []) -> super # structure_item i
+      | _, false :: _ -> empty_str_item
 
     method! expr = function
-      | {pexp_desc = Pexp_construct (
-         {txt = Lident "GETENV"},
-         Some {pexp_loc = loc; pexp_desc = Pexp_construct (
-               {txt = Lident sym},
-               None,
-               _
-              )},
-         _
-        )} ->
-          E.strconst ~loc (getenv sym)
+      | {pexp_desc = Pexp_extension({txt="GETENV";loc=l}, arg); pexp_loc = loc; _} ->
+          Exp.constant ~loc (Const_string (getenv l arg, None))
       | x -> super # expr x
   end
 
-let () = ifdef # main
+let () = Ast_mapper.main ifdef
diff --git a/experimental/frisch/js_syntax.ml b/experimental/frisch/js_syntax.ml
index 5e332f92f..518196eb1 100644
--- a/experimental/frisch/js_syntax.ml
+++ b/experimental/frisch/js_syntax.ml
@@ -3,29 +3,29 @@
    (properties and method calls). The code below overloads regular
    syntax for field projection and assignment for Javascript
    properties, and (currified) method call for Javascript method
-   calls. This is enabled by a fake local open on pseudo module JS,
-   i.e.  in a scope like "JS.(...)" or "let open JS in ...".
+   calls. This is enabled under the scope of the [%js ...] extension:
+
+     Get property:   [%js o.x]
+     Set property:   [%js o.x <- e]
+     Method call:    [%js o#x e1 e2]
  *)
 
 open Asttypes
-open Ast_mapper
-open Location
+open! Location
 open Parsetree
 open Longident
+open Ast_helper
+open Ast_helper.Convenience
 
 (* A few local helper functions to simplify the creation of AST nodes. *)
-let constr_ c l = T.constr (mknoloc (Longident.parse c)) l
-let apply_ f l = E.apply_nolabs (E.lid f) l
-let oobject l = T.object_ (List.map (fun (s, t) -> T.field s t) l @ [T.field_var ()])
-let eident x = E.ident (mknoloc (Lident x))
-let pvar x = P.var (mknoloc x)
-let annot e t = E.constraint_ e (Some t) None
-
+let apply_ f l = app (evar f) l
+let oobject l = Typ.object_ l Open
+let annot e t = Exp.constraint_ e t
 
 
 let rnd = Random.State.make [|0x513511d4|]
 let random_var () = Format.sprintf "a%08Lx" (Random.State.int64 rnd 0x100000000L : Int64.t)
-let fresh_type () = T.var (random_var ())
+let fresh_type () = Typ.var (random_var ())
 
 let unescape lab =
   assert (lab <> "");
@@ -39,64 +39,66 @@ let unescape lab =
   with Not_found ->
     lab
 
-let method_literal meth = E.strconst (unescape meth)
+let method_literal meth = str (unescape meth)
 
 let access_object loc e m m_typ f =
-  let open E in
-  let x = random_var () in
-  let obj_type = random_var () in
-  let obj = annot e T.(constr_ "Js.t" [alias (oobject []) obj_type]) in
-  let y = random_var () in
-  let o = annot (eident y) (T.var obj_type) in
-  let constr = function_ "" None [pvar y, annot (send o m) m_typ] in
-  let e = let_ Nonrecursive [pvar x, obj; P.any (), constr] (f (eident x)) in
-  (set_loc loc) # expr e
+  let open Exp in
+  with_default_loc loc
+    (fun () ->
+      let x = random_var () in
+      let obj_type = random_var () in
+      let obj = annot e Typ.(tconstr "Js.t" [alias (oobject []) obj_type]) in
+      let y = random_var () in
+      let o = annot (evar y) (Typ.var obj_type) in
+      let constr = lam (pvar y) (annot (send o m) m_typ) in
+      let_in [Vb.mk (pvar x) obj; Vb.mk (Pat.any ()) constr] (f (evar x))
+    )
 
 let method_call loc obj meth args =
   let args = List.map (fun e -> (e, fresh_type ())) args in
   let ret_type = fresh_type () in
   let method_type =
     List.fold_right
-      (fun (_, arg_ty) rem_ty -> T.arrow "" arg_ty rem_ty)
+      (fun (_, arg_ty) rem_ty -> Typ.arrow "" arg_ty rem_ty)
       args
-      (constr_ "Js.meth" [ret_type])
+      (tconstr "Js.meth" [ret_type])
   in
   access_object loc obj meth method_type
     (fun x ->
       let args =
         List.map (fun (e, t) -> apply_ "Js.Unsafe.inject" [annot e t]) args
       in
-      annot (apply_ "Js.Unsafe.meth_call" [x; method_literal meth; E.array args]) ret_type
+      annot (apply_ "Js.Unsafe.meth_call" [x; method_literal meth; Exp.array args]) ret_type
     )
 
 
 let mapper =
   object(this)
-    inherit Ast_mapper.create as super
+    inherit Ast_mapper.mapper as super
 
     val js = false
 
     method! expr e =
       let loc = e.pexp_loc in
       match e.pexp_desc with
-      | Pexp_open ({txt = Lident "JVS"; loc = _}, e) ->
+      | Pexp_extension({txt="js";_}, PStr [{pstr_desc=Pstr_eval (e, _);_}]) ->
           {< js = true >} # expr e
 
       | Pexp_field (o, {txt = Lident meth; loc = _}) when js ->
           let o = this # expr o in
           let prop_type = fresh_type () in
-          let meth_type = constr_ "Js.gen_prop" [oobject ["get", prop_type]] in
+          let meth_type = tconstr "Js.gen_prop" [oobject ["get", prop_type]] in
           access_object loc o meth meth_type
             (fun x -> annot (apply_ "Js.Unsafe.get" [x; method_literal meth]) prop_type)
 
       | Pexp_setfield (o, {txt = Lident meth; loc = _}, e) when js ->
           let o = this # expr o and e = this # expr e in
           let prop_type = fresh_type () in
-          let meth_type = constr_ "Js.gen_prop" [oobject ["set", T.arrow "" prop_type (constr_ "unit" [])]] in
+          let meth_type = tconstr "Js.gen_prop" [oobject ["set", Typ.arrow "" prop_type (tconstr "unit" [])]] in
           access_object loc o meth meth_type
             (fun x -> apply_ "Js.Unsafe.set" [x; method_literal meth; annot e prop_type])
 
-      | Pexp_apply ({pexp_desc = Pexp_send (o, meth); pexp_loc = loc}, args) when js ->
+      | Pexp_apply ({pexp_desc = Pexp_send (o, meth); pexp_loc = loc; _}, args) when js ->
           method_call loc o meth (List.map (this # expr) (List.map snd args))
 
       | Pexp_send (o, meth) when js ->
@@ -106,4 +108,4 @@ let mapper =
           super # expr e
   end
 
-let () = mapper # main
+let () = Ast_mapper.main mapper
diff --git a/experimental/frisch/metaquot.ml b/experimental/frisch/metaquot.ml
new file mode 100644
index 000000000..d038e3a70
--- /dev/null
+++ b/experimental/frisch/metaquot.ml
@@ -0,0 +1,183 @@
+(* A -ppx rewriter to be used to write Parsetree-generating code
+   (including other -ppx rewriters) using concrete syntax.
+
+   See metaquot_test.ml for an example.
+
+   We support the following extensions in expression position:
+
+   [%expr ...]  maps to code which creates the expression represented by ...
+   [%pat "..."] maps to code which creates the pattern represented by ...
+   [%pat "..."] maps to code which creates the pattern represented by ...
+   [%str ...] maps to code which creates the structure represented by ...
+   [type "..."] maps to code which creates the core type represented by ...
+
+   Note that except for the expr and str expander, the argument needs to be
+   a string literal (it can also be a quoted string, of course), which
+   will be re-parse by the expander (in case of a parsing error,
+   the location will be relative to the parsed string).
+
+   Quoted code can refer to expressions representing AST fragments,
+   using the following extensions:
+
+     [%e ...] where ... is an expression of type Parsetree.expression
+     [%t ...] where ... is an expression of type Parsetree.core_type
+     [%p ...] where ... is an expression of type Parsetree.pattern
+
+
+   All locations generated by the meta quotation are by default set
+   to Location.none.  This can be overriden by providing a custom
+   expression which will be inserted whereever a location is required
+   in the generated AST.  This expression can be specified globally
+   (for the current structure) as a structure item attribute:
+
+     ;;[@@metaloc ...]
+
+   or locally for the scope of an expression:
+
+     e [@metaloc ...]
+
+   No support is provided for meta quotation in pattern position.
+*)
+
+module Main : sig end = struct
+  open Asttypes
+  open Parsetree
+  open Ast_helper
+  open Ast_helper.Convenience
+
+  let prefix ty s =
+    let open Longident in
+    match parse ty with
+    | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s
+    | _ -> s
+
+  class exp_builder =
+    object
+      method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x)
+      method constr ty (c, args) = constr (prefix ty c) args
+      method list = list
+      method tuple = tuple
+      method int = int
+      method string = str
+      method char = char
+      method int32 x = Exp.constant (Const_int32 x)
+      method int64 x = Exp.constant (Const_int64 x)
+      method nativeint x = Exp.constant (Const_nativeint x)
+    end
+
+
+  let get_exp loc = function
+    | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
+    | _ ->
+        Format.eprintf "%aExpression expected@."
+          Location.print_error loc;
+        exit 2
+
+  let get_typ loc = function
+    | PTyp t -> t
+    | _ ->
+        Format.eprintf "%aType expected@."
+          Location.print_error loc;
+        exit 2
+
+  let get_pat loc = function
+    | PPat (t, None) -> t
+    | _ ->
+        Format.eprintf "%aPattern expected@."
+          Location.print_error loc;
+        exit 2
+
+  let lifter loc =
+    object
+      inherit [_] Ast_lifter.lifter as super
+      inherit exp_builder
+
+          (* Special support for location in the generated AST *)
+      method! lift_Location_t _ = loc
+
+          (* Support for antiquotations *)
+      method! lift_Parsetree_expression = function
+        | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> get_exp loc e
+        | x -> super # lift_Parsetree_expression x
+
+      method! lift_Parsetree_pattern = function
+        | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> get_exp loc e
+        | x -> super # lift_Parsetree_pattern x
+
+      method! lift_Parsetree_core_type = function
+        | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> get_exp loc e
+        | x -> super # lift_Parsetree_core_type x
+    end
+
+  let loc = ref (evar "Location.none")
+  let handle_attr = function
+    | {txt="metaloc";loc=l}, e -> loc := get_exp l e
+    | _ -> ()
+
+  let with_loc ?(attrs = []) f =
+    let old_loc = !loc in
+    List.iter handle_attr attrs;
+    let r = f () in
+    loc := old_loc;
+    r
+
+  let report_error ppf exn =
+    let report ppf = function
+      | Lexer.Error(err, loc) ->
+          Location.print_error ppf loc;
+          Lexer.report_error ppf err
+      | Syntaxerr.Error err ->
+          Syntaxerr.report_error ppf err
+      | x ->
+          Format.fprintf ppf "%s" (Printexc.to_string x)
+    in
+    Format.fprintf ppf "@[%a@]@." report exn
+
+  let extract_str parse kind = function
+    | {pexp_desc = Pexp_constant (Const_string (s, _)); pexp_loc = loc; _} ->
+        begin try parse (Lexing.from_string s)
+        with exn ->
+          Location.print_error Format.std_formatter loc;
+          Format.eprintf "Error while parsing a %s quotation:@.%a@." kind
+            report_error exn;
+          exit 2
+        end
+    | {pexp_loc = loc; _} ->
+        Location.print_error Format.std_formatter loc;
+        Format.eprintf
+          "The content of this quotation must be a string literal.@.";
+        exit 2
+
+  let expander = object
+    inherit Ast_mapper.mapper as super
+
+    method! expr e =
+      with_loc ~attrs:e.pexp_attributes
+        (fun () ->
+          match e.pexp_desc with
+          | Pexp_extension({txt="expr";loc=l}, e) ->
+              (lifter !loc) # lift_Parsetree_expression (get_exp l e)
+          | Pexp_extension({txt="pat";loc=l}, e) ->
+              (lifter !loc) # lift_Parsetree_pattern (get_pat l e)
+          | Pexp_extension({txt="str";_}, PStr e) ->
+              (lifter !loc) # lift_Parsetree_structure e
+          | Pexp_extension({txt="type";loc=l}, e) ->
+              (lifter !loc) # lift_Parsetree_core_type (get_typ l e)
+          | _ ->
+              super # expr e
+        )
+
+    method! structure l =
+      with_loc
+        (fun () -> super # structure l)
+
+    method! structure_item x =
+      begin match x.pstr_desc with
+      | Pstr_attribute x -> handle_attr x
+      | _ -> ()
+      end;
+      super # structure_item x
+  end
+
+  let () = Ast_mapper.main expander
+end
diff --git a/experimental/frisch/metaquot_test.ml b/experimental/frisch/metaquot_test.ml
new file mode 100644
index 000000000..b389f18ee
--- /dev/null
+++ b/experimental/frisch/metaquot_test.ml
@@ -0,0 +1,21 @@
+let loc1 = Location.in_file "111"
+let loc2 = Location.in_file "222"
+
+let x = [%expr foobar]
+let pat = [%pat? _ as x]
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+;;[@@metaloc loc2]
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1] [@metaloc loc1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+
+let mytype = [%type: int list]
+let s = [%str type t = A of [%t mytype] | B of string]
+let () = Format.printf "%a@." Printast.implementation s
diff --git a/experimental/frisch/minidoc.ml b/experimental/frisch/minidoc.ml
new file mode 100644
index 000000000..bf37a0123
--- /dev/null
+++ b/experimental/frisch/minidoc.ml
@@ -0,0 +1,72 @@
+open Asttypes
+open Parsetree
+open Typedtree
+open Longident
+
+let pendings = ref []
+
+let doc ppf = function
+  | ({txt="doc";_}, PStr [{pstr_desc=Pstr_eval(e, _); _}]) ->
+      begin match e.pexp_desc with
+      | Pexp_constant(Const_string (s, _)) ->
+          Format.fprintf ppf "    --> %s@." s
+      | Pexp_apply({pexp_desc=Pexp_ident{txt=Lident "section"}},
+                   ["", {pexp_desc=Pexp_constant(Const_string (s, _))}]) ->
+                     Format.fprintf ppf "  ==== %s ====@." s
+      | _ -> ()
+      end
+  | _ -> ()
+
+let rec signature path ppf sg =
+  List.iter (signature_item path ppf) sg.sig_items
+
+and signature_item path ppf si =
+  match si.sig_desc with
+  | Tsig_value x ->
+      Format.fprintf ppf "  val %s: %a@." x.val_name.txt Printtyp.type_expr x.val_desc.ctyp_type;
+      List.iter (doc ppf) x.val_attributes
+  | Tsig_module x ->
+      begin match x.md_type.mty_desc with
+      | Tmty_ident (_, {txt=lid}) ->
+          Format.fprintf ppf "  module %s: %a@." x.md_name.txt Printtyp.longident lid
+      | Tmty_signature sg ->
+          pendings := `Module (path ^ "." ^ x.md_name.txt, sg) :: !pendings;
+          Format.fprintf ppf "  module %s: ... (see below)@." x.md_name.txt;
+      | _ ->
+          Format.fprintf ppf "  module %s: ...@." x.md_name.txt;
+      end;
+      List.iter (doc ppf) x.md_attributes
+  | Tsig_type l ->
+      List.iter (type_declaration ppf) l
+  | Tsig_attribute x ->
+      doc ppf x
+  | _ ->
+      ()
+
+and type_declaration ppf x =
+  Format.fprintf ppf "  type %s@." x.typ_name.txt;
+  List.iter (doc ppf) x.typ_attributes
+
+let component = function
+  | `Module (path, sg) ->
+      Format.printf "[[[ Interface for %s ]]]@.%a@."
+        path (signature path) sg
+
+let () =
+  let open Cmt_format in
+  for i = 1 to Array.length Sys.argv - 1 do
+    let fn = Sys.argv.(i) in
+    try
+      let {cmt_annots; cmt_modname; _} = read_cmt fn in
+      begin match cmt_annots with
+      | Interface sg -> component (`Module (cmt_modname, sg))
+      | _ -> ()
+      end;
+      while !pendings <> [] do
+        let l = List.rev !pendings in
+        pendings := [];
+        List.iter component l
+      done
+    with exn ->
+      Format.printf "Cannot read '%s': %s@." fn (Printexc.to_string exn)
+  done
diff --git a/experimental/frisch/nomli.ml b/experimental/frisch/nomli.ml
new file mode 100644
index 000000000..6cf34557b
--- /dev/null
+++ b/experimental/frisch/nomli.ml
@@ -0,0 +1,114 @@
+(** Creates an mli from an annotated ml file. *)
+
+open Path
+open Location
+open Longident
+open Misc
+open Parsetree
+open Types
+open! Typedtree
+open Ast_helper
+
+let mli_attr l = Convenience.find_attr "mli" l
+
+let map_flatten f l =
+  List.flatten (List.map f l)
+
+let is_abstract = function
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_ident{txt=Lident "abstract"}},_)}] -> true
+  | _ -> false
+
+let explicit_type_of_expr = function
+  | {pexp_desc=Pexp_constraint({pexp_desc=Pexp_ident{txt=Lident id}}, t)} -> [id, t]
+  | _ -> []
+
+let explicit_type = function
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_tuple el},_)}] -> map_flatten explicit_type_of_expr el
+  | PStr [{pstr_desc=Pstr_eval(e,_)}] -> explicit_type_of_expr e
+  | _ -> []
+
+let rec structure l : Parsetree.signature =
+  map_flatten (structure_item l.str_final_env) l.str_items
+
+and structure_item final_env x : Parsetree.signature =
+  match x.str_desc with
+  | Tstr_module {mb_name; mb_expr} ->
+    begin match module_expr mb_expr with
+    | Some mty -> [Sig.module_ (Md.mk mb_name mty)]
+    | None -> []
+    end
+  | Tstr_type l ->
+    begin match map_flatten type_declaration l with
+    | [] -> []
+    | l -> [Sig.type_ l]
+    end
+  | Tstr_value (_, l) ->
+    map_flatten (value_binding final_env) l
+  | _ ->
+    []
+
+and module_expr x : Parsetree.module_type option =
+  match x.mod_desc with
+  | Tmod_structure l ->
+    (* No explicit signature: use [@@mli] attributes in the sub-structure to define exported components. *)
+    begin match structure l with
+    | [] -> None
+    | l -> Some (Mty.signature l)
+    end
+  | Tmod_constraint (_, _, Tmodtype_explicit mty, _) ->
+    (* Explicit signature: if non-empty, use it for the mli; if empty, drop the sub-module *)
+    begin match Untypeast.untype_module_type mty with
+    | {pmty_desc=Pmty_signature []} -> None
+    | pmty -> Some pmty
+    end
+  | _ ->
+    None
+
+and type_declaration x : Parsetree.type_declaration list =
+  match mli_attr x.typ_attributes with
+  | None -> []
+  | Some attrs ->
+    let pdecl = Untypeast.untype_type_declaration x in
+    (* If the declaration is marked with [@@mli abstract], make it abstract *)
+    let pdecl = if is_abstract attrs then {pdecl with ptype_kind=Ptype_abstract} else pdecl in
+    [pdecl]
+
+and value_binding final_env x : Parsetree.signature =
+  match mli_attr x.vb_attributes with
+  | None -> []
+  | Some attrs ->
+    match explicit_type attrs with
+    | [] ->
+      (* No explicit type, use the inferred type for bound identifiers *)
+      let ids = let_bound_idents [x] in
+      List.map
+        (fun id ->
+           let ty = typ (Env.find_value (Pident id) final_env).val_type in
+           Sig.value (Val.mk (mknoloc (Ident.name id)) ty)
+        ) ids
+    | l ->
+      (* Explicit type given with the syntax [@@mli (x1 : ty1), ..., (xn : tyn)] *)
+      List.map (fun (id, ty) -> Sig.value (Val.mk (mknoloc id) ty)) l
+
+and typ x : Parsetree.core_type =
+  (* print the inferred type and parse the result again *)
+  let t = Printtyp.type_scheme Format.str_formatter x in
+  let s = Format.flush_str_formatter t in
+  Parse.core_type (Lexing.from_string s)
+
+let mli_of_ml ppf sourcefile =
+  Location.input_name := sourcefile;
+  Compmisc.init_path false;
+  let file = chop_extension_if_any sourcefile in
+  let modulename = String.capitalize(Filename.basename file) in
+  Env.set_unit_name modulename;
+  let inputfile = Pparse.preprocess sourcefile in
+  let env = Compmisc.initial_env() in
+  let ast = Pparse.file ppf inputfile Parse.implementation Config.ast_impl_magic_number in
+  let (str, _coerc) = Typemod.type_implementation sourcefile file modulename env ast in
+  let sg = structure str in
+  Format.printf "%a@." Pprintast.signature sg
+
+let () =
+  mli_of_ml Format.err_formatter Sys.argv.(1)
+
diff --git a/experimental/frisch/ppx_builder.ml b/experimental/frisch/ppx_builder.ml
new file mode 100644
index 000000000..262274cb4
--- /dev/null
+++ b/experimental/frisch/ppx_builder.ml
@@ -0,0 +1,97 @@
+(*
+  A toy -ppx rewriter which illustrates code generation based on type
+  declarations.  Here, we create builder function from record and sum
+  type declarations annotated with attribute [@@builder]: one function
+  per record type, one function per constructor of a sum type.
+
+  We recognize some special attributes on record fields (or their associated
+  type) and on constructor argument types:
+
+  - [@label id]: specify a label for the parameter of the builder function
+    (for records, it is set automatically from the label name
+    but it can be overridden).
+
+  - [@opt]: the parameter is optional (this assume that the field/argument
+    has an option type).
+
+  - [@default expr]: the parameter is optional, with a default value
+    (cannot be used with [@opt]).
+*)
+
+module Main : sig end = struct
+  open Asttypes
+  open! Location
+  open Parsetree
+  open Ast_helper
+  open Ast_helper.Convenience
+
+  let fatal loc s =
+    Location.print_error Format.err_formatter loc;
+    prerr_endline s;
+    exit 2
+
+  let param named name loc attrs =
+    let default = find_attr_expr "default" attrs in
+    let opt = has_attr "opt" attrs in
+    let label =
+      match find_attr_expr "label" attrs with
+      | None -> if named then name else ""
+      | Some e ->
+          match get_lid e with
+          | Some s -> s
+          | None -> fatal e.pexp_loc "'label' attribute must be a string literal"
+    in
+    let label =
+      if default <> None || opt then
+        if label = "" then fatal loc "Optional arguments must be named" else "?" ^ label
+      else label
+    in
+    if default <> None && opt then fatal loc "Cannot have both 'opt' and 'default' attributes";
+    lam ~label ?default (pvar name), (name, evar name)
+
+  let gen_builder tdecl =
+    if has_attr "builder" tdecl.ptype_attributes then
+      match tdecl.ptype_kind with
+      | Ptype_record fields ->
+          let field pld =
+            param true pld.pld_name.txt pld.pld_loc (pld.pld_attributes @ pld.pld_type.ptyp_attributes)
+          in
+          let fields = List.map field fields in
+          let body = lam (punit()) (record (List.map snd fields)) in
+          let f = List.fold_right (fun (f, _) k -> f k) fields body in
+          let s = Str.value Nonrecursive [Vb.mk (pvar tdecl.ptype_name.txt) f] in
+          [s]
+      | Ptype_variant constrs ->
+          let constr {pcd_name={txt=name;_}; pcd_args=args; _} =
+            let arg i ty = param false (Printf.sprintf "x%i" i) ty.ptyp_loc ty.ptyp_attributes in
+            let args = List.mapi arg args in
+            let body = lam (punit()) (constr name (List.map (fun (_, (_, e)) -> e) args)) in
+            let f = List.fold_right (fun (f, _) k -> f k) args body in
+            let s = Str.value Nonrecursive [Vb.mk (pvar (tdecl.ptype_name.txt ^ "_" ^ name)) f] in
+            s
+          in
+          List.map constr constrs
+      | _ -> []
+    else
+      []
+
+  let gen_builder tdecl =
+    with_default_loc tdecl.ptype_loc (fun () -> gen_builder tdecl)
+
+  let builder = object(this)
+    inherit Ast_mapper.mapper
+
+    method! structure l =
+      List.flatten
+        (List.map
+           (function
+             | {pstr_desc = Pstr_type tdecls; _} as i ->
+                 i :: (List.flatten (List.map gen_builder tdecls))
+             | i -> [this # structure_item i]
+           )
+           l
+        )
+  end
+
+  let () = Ast_mapper.main builder
+end
diff --git a/experimental/frisch/test_builder.ml b/experimental/frisch/test_builder.ml
new file mode 100644
index 000000000..254273090
--- /dev/null
+++ b/experimental/frisch/test_builder.ml
@@ -0,0 +1,19 @@
+type t =
+    {
+     x: int;
+     y [@label foo]: int;
+     z [@default 3]: int;
+    } [@@builder]
+
+and s =
+    {
+     a: string;
+     b [@opt]: int option;
+     c: int [@default 2];
+    } [@@builder]
+
+and sum =
+  | A of int
+  | B of string * (string [@label str])
+  | C of (int [@label i] [@default 0]) * (string [@label s] [@default ""])
+        [@@builder]
diff --git a/experimental/frisch/test_copy_typedef.ml b/experimental/frisch/test_copy_typedef.ml
new file mode 100644
index 000000000..cd774c691
--- /dev/null
+++ b/experimental/frisch/test_copy_typedef.ml
@@ -0,0 +1,19 @@
+module type S = [%copy_typedef]
+
+module type T = sig
+  type t
+
+  module type M = [%copy_typedef]
+end
+
+module M = struct
+  type t = [%copy_typedef]
+end
+
+type t = [%copy_typedef]
+
+let _x = M.A
+let _y : t = [1; 2]
+
+
+type _loc = [%copy_typedef "../../parsing/location.mli" t]
diff --git a/experimental/frisch/test_copy_typedef.mli b/experimental/frisch/test_copy_typedef.mli
new file mode 100644
index 000000000..8e137a7d2
--- /dev/null
+++ b/experimental/frisch/test_copy_typedef.mli
@@ -0,0 +1,20 @@
+module type S = sig
+  type t
+  val x: int
+end
+
+module type T = sig
+  type t
+
+  module type M = sig
+    type t = A | B of t
+  end
+end
+
+module M : sig
+  type t =
+    | A
+    | B of string
+end
+
+type t = int list
diff --git a/experimental/frisch/test_eval.ml b/experimental/frisch/test_eval.ml
new file mode 100644
index 000000000..c0dfc697f
--- /dev/null
+++ b/experimental/frisch/test_eval.ml
@@ -0,0 +1,37 @@
+[%%eval.load "unix.cma"]
+
+[%%eval.start both]
+(* This type definition will be evaluated at compile time,
+   but it will be kept in the compiled unit as well. *)
+type t = A | B of string
+[%%eval.stop]
+
+[%%eval.start]
+(* This is going to be executed at compile time only. *)
+let () = print_endline "Now compiling..."
+[%%eval.stop]
+
+let () =
+  begin match [%eval B "x"] with
+  | A -> print_endline "A"
+  | B s -> Printf.printf "B %S\n%!" s
+  end;
+  Printf.printf "Home dir at compile time = %s\n" [%eval Sys.getenv "HOME"];
+  Printf.printf "Word-size = %i\n" [%eval Sys.word_size];
+  Array.iter (Printf.printf "%s;") [%eval Sys.readdir "."];
+  print_endline "";
+  [%eval print_endline "COUCOU"]
+
+let () =
+  let tm = [%eval Unix.(localtime (gettimeofday ()))] in
+  Printf.printf "This program was compiled in %i\n%!" (1900 + tm.Unix.tm_year)
+
+let () =
+  let debug =
+    [%eval try Some (Sys.getenv "DEBUG") with Not_found -> None]
+  in
+  match debug with
+  | Some x -> Printf.printf "DEBUG %s\n%!" x
+  | None -> Printf.printf "NODEBUG\n%!"
+
+
diff --git a/experimental/frisch/test_ifdef.ml b/experimental/frisch/test_ifdef.ml
index 6f1479019..4b7eafb34 100644
--- a/experimental/frisch/test_ifdef.ml
+++ b/experimental/frisch/test_ifdef.ml
@@ -1,12 +1,24 @@
-include IFDEF(XHOME)(struct
-  let () = print_endline "Defined!"
-end)
-(struct
-  let () = print_endline "Not defined!"
-end)
+type t =
+  | A
+  | DBG [@IFDEF DEBUG] of string
+  | B
 
+[%%IFDEF DEBUG]
+let debug s = prerr_endline ([%GETENV DEBUG] ^ ":" ^ s)
+let x = DBG "xxx"
+[%%ELSE]
+let debug _ = ()
+let x = A
+[%%END]
+
+let f = function
+  | A -> "A"
+  | DBG s when [%IFDEF DEBUG] -> "DEBUG:" ^ s
+  | B -> "B"
+
+let () = debug "ABC"
 
 let () =
   Printf.printf "compiled by user %s in directory %s\n%!"
-    (GETENV USER)
-    (GETENV PWD)
+    [%GETENV USER]
+    [%GETENV PWD]
diff --git a/experimental/frisch/test_js.ml b/experimental/frisch/test_js.ml
index 2bbd342c1..2582a0fba 100644
--- a/experimental/frisch/test_js.ml
+++ b/experimental/frisch/test_js.ml
@@ -12,11 +12,11 @@ module Js = struct
 end
 
 let foo1 o =
-  if JVS.(o.bar) then JVS.(o.foo1.foo2) else JVS.(o.foo2)
+  if [%js o.bar] then [%js o.foo1.foo2] else [%js o.foo2]
 
 let foo2 o =
-  JVS.(o.x <- o.x + 1)
+  [%js o.x <- o.x + 1]
 
 
 let foo3 o a =
-  JVS.(o#x) + JVS.(o#y 1 a)
+  [%js o#x] + [%js o#y 1 a]
diff --git a/experimental/frisch/test_nomli.ml b/experimental/frisch/test_nomli.ml
new file mode 100644
index 000000000..affa07678
--- /dev/null
+++ b/experimental/frisch/test_nomli.ml
@@ -0,0 +1,30 @@
+type t = A | B
+  [@@mli]
+
+and s = C | D
+  [@@mli abstract]
+
+
+module X = struct
+  type t = X | Y
+  [@@mli]
+  and s
+
+  let id x = x
+    [@@mli]
+end
+
+module Y : sig type t type s end = struct
+  type t = X | Y
+  type s = A | B
+end
+
+let f x y = x + y
+    [@@mli]
+and g a b = (a, b)
+    [@@mli]
+and h a b = (a, b)
+    [@@mli (h : int -> int -> int * int)]
+
+let (x, y, z) = (1, 2, 3)
+    [@@mli (x : int), (y : int)]
diff --git a/experimental/frisch/test_trace.ml b/experimental/frisch/test_trace.ml
deleted file mode 100644
index fc4f1ec2a..000000000
--- a/experimental/frisch/test_trace.ml
+++ /dev/null
@@ -1,24 +0,0 @@
-type t = int
-
-module A =
-  struct
-    let () = print_endline "FOO"
-  end
-
-module B =
-  struct
-    let () = print_endline "BAR"
-
-    module C =
-      struct
-      end
-  end
-
-
-let () =
-  let o = object
-    method x = 1
-    method y = 2
-  end
-  in
-  ignore (o # x + o # y)
diff --git a/experimental/frisch/testdoc.mli b/experimental/frisch/testdoc.mli
new file mode 100644
index 000000000..c22307ae1
--- /dev/null
+++ b/experimental/frisch/testdoc.mli
@@ -0,0 +1,29 @@
+[@@doc section "First section"]
+
+module M : sig
+  [@@doc section "Public definitions"]
+
+  type t =
+    | A
+    | B
+
+  [@@doc section "Internal definitions"]
+
+  val zero: int
+      [@@doc "A very important integer."]
+end
+  [@@doc "This is an internal module."]
+
+val incr: int -> int
+  [@@doc "This function returns the next integer."]
+
+[@@doc section "Second section"]
+
+val decr: int -> int
+  [@@doc "This function returns the previous integer."]
+
+val is_a: M.t -> bool
+  [@@doc "This function checks whether its argument is the A constructor."]
+
+module X: Hashtbl.HashedType
+  [@@doc "An internal module"]
diff --git a/experimental/frisch/tracer.ml b/experimental/frisch/tracer.ml
deleted file mode 100644
index 657756a32..000000000
--- a/experimental/frisch/tracer.ml
+++ /dev/null
@@ -1,43 +0,0 @@
-open Ast_mapper
-open Location
-open Parsetree
-
-(* To define a concrete AST rewriter, we can inherit from the generic
-   mapper, and redefine the cases we are interested in.  In the
-   example below, we insert in the AST some debug statements around
-   each module structure. We also keep track of the current "path" in
-   the compilation unit.  *)
-
-let trace s =
-  E.(apply (lid "Pervasives.print_endline") ["", strconst s])
-
-let tracer =
-  object(this)
-    inherit Ast_mapper.create as super
-    val path = ""
-
-    method! implementation input_name ast =
-      let path = String.capitalize (Filename.chop_extension input_name) in
-      (input_name, {< path = path >} # structure ast)
-
-    method! structure_item = function
-      | {pstr_desc = Pstr_module (s, _); pstr_loc = _loc} as si ->
-          [ M.map_structure_item {< path = path ^ "." ^ s.txt >} si ]
-      | si ->
-          [ M.map_structure_item this si ]
-
-    method! structure l =
-      M.eval (trace (Printf.sprintf "Entering module %s" path)) ::
-      (super # structure l) @
-      [ M.eval (trace (Printf.sprintf "Leaving module %s" path)) ]
-
-    method! expr e =
-      match e.pexp_desc with
-      | Pexp_send (_, s) ->
-          E.sequence (trace (Printf.sprintf "calling method %s" s)) (super # expr e)
-      | _ ->
-          super # expr e
-
-  end
-
-let () = tracer # main
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 6901f85fb..eabb24c63 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -676,6 +676,7 @@ let camlp4_import_list =
      "parsing/longident.ml";
      "parsing/asttypes.mli";
      "parsing/parsetree.mli";
+     "parsing/ast_helper.ml";
      "typing/outcometree.mli";
      "typing/oprint.ml";
      "myocamlbuild_config.ml";
diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile
index 0dfa79cc6..bf4b32d9a 100644
--- a/ocamldoc/Makefile
+++ b/ocamldoc/Makefile
@@ -150,6 +150,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \
 	$(OCAMLSRCDIR)/parsing/location.cmo\
 	$(OCAMLSRCDIR)/parsing/longident.cmo \
 	$(OCAMLSRCDIR)/parsing/syntaxerr.cmo \
+	$(OCAMLSRCDIR)/parsing/ast_helper.cmo \
 	$(OCAMLSRCDIR)/parsing/parser.cmo \
 	$(OCAMLSRCDIR)/parsing/lexer.cmo \
 	$(OCAMLSRCDIR)/parsing/parse.cmo \
@@ -166,8 +167,8 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \
 	$(OCAMLSRCDIR)/typing/oprint.cmo \
 	$(OCAMLSRCDIR)/typing/printtyp.cmo \
 	$(OCAMLSRCDIR)/typing/includecore.cmo \
-	$(OCAMLSRCDIR)/typing/typetexp.cmo \
 	$(OCAMLSRCDIR)/typing/typedtree.cmo \
+	$(OCAMLSRCDIR)/typing/typetexp.cmo \
 	$(OCAMLSRCDIR)/typing/parmatch.cmo \
 	$(OCAMLSRCDIR)/typing/stypes.cmo \
 	$(OCAMLSRCDIR)/typing/typedtreeMap.cmo \
diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt
index 6b9818a96..6343d9810 100644
--- a/ocamldoc/Makefile.nt
+++ b/ocamldoc/Makefile.nt
@@ -140,6 +140,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \
 	$(OCAMLSRCDIR)/parsing/location.cmo\
 	$(OCAMLSRCDIR)/parsing/longident.cmo \
 	$(OCAMLSRCDIR)/parsing/syntaxerr.cmo \
+	$(OCAMLSRCDIR)/parsing/ast_helper.cmo \
 	$(OCAMLSRCDIR)/parsing/parser.cmo \
 	$(OCAMLSRCDIR)/parsing/lexer.cmo \
 	$(OCAMLSRCDIR)/parsing/parse.cmo \
@@ -156,8 +157,8 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \
 	$(OCAMLSRCDIR)/typing/oprint.cmo \
 	$(OCAMLSRCDIR)/typing/printtyp.cmo \
 	$(OCAMLSRCDIR)/typing/includecore.cmo \
-	$(OCAMLSRCDIR)/typing/typetexp.cmo \
 	$(OCAMLSRCDIR)/typing/typedtree.cmo \
+	$(OCAMLSRCDIR)/typing/typetexp.cmo \
 	$(OCAMLSRCDIR)/typing/parmatch.cmo \
 	$(OCAMLSRCDIR)/typing/stypes.cmo \
 	$(OCAMLSRCDIR)/typing/typedtreeMap.cmo \
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 039bbb482..a4da0f73a 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -64,26 +64,26 @@ module Typedtree_search =
 
     let add_to_hashes table table_values tt =
       match tt with
-      | Typedtree.Tstr_module (ident, _, _) ->
-          Hashtbl.add table (M (Name.from_ident ident)) tt
+      | Typedtree.Tstr_module mb ->
+          Hashtbl.add table (M (Name.from_ident mb.mb_id)) tt
       | Typedtree.Tstr_recmodule mods ->
           List.iter
-            (fun (ident,ident_loc, _, mod_expr) ->
-              Hashtbl.add table (M (Name.from_ident ident))
-                (Typedtree.Tstr_module (ident,ident_loc, mod_expr))
+            (fun mb ->
+              Hashtbl.add table (M (Name.from_ident mb.mb_id))
+                (Typedtree.Tstr_module mb)
             )
             mods
-      | Typedtree.Tstr_modtype (ident, _, _) ->
-          Hashtbl.add table (MT (Name.from_ident ident)) tt
-      | Typedtree.Tstr_exception (ident, _, _) ->
-          Hashtbl.add table (E (Name.from_ident ident)) tt
-      | Typedtree.Tstr_exn_rebind (ident, _, _, _) ->
+      | Typedtree.Tstr_modtype mtd ->
+          Hashtbl.add table (MT (Name.from_ident mtd.mtd_id)) tt
+      | Typedtree.Tstr_exception decl ->
+          Hashtbl.add table (E (Name.from_ident decl.cd_id)) tt
+      | Typedtree.Tstr_exn_rebind (ident, _, _, _, _) ->
           Hashtbl.add table (ER (Name.from_ident ident)) tt
       | Typedtree.Tstr_type ident_type_decl_list ->
           List.iter
-            (fun (id, id_loc, e) ->
-              Hashtbl.add table (T (Name.from_ident id))
-                (Typedtree.Tstr_type [(id,id_loc,e)]))
+            (fun td ->
+              Hashtbl.add table (T (Name.from_ident td.typ_id))
+                (Typedtree.Tstr_type [td]))
             ident_type_decl_list
       | Typedtree.Tstr_class info_list ->
           List.iter
@@ -100,17 +100,18 @@ module Typedtree_search =
             info_list
       | Typedtree.Tstr_value (_, pat_exp_list) ->
           List.iter
-            (fun (pat,exp) ->
+            (fun {vb_pat=pat; vb_expr=exp} ->
               match iter_val_pattern pat.Typedtree.pat_desc with
                 None -> ()
               | Some n -> Hashtbl.add table_values n (pat,exp)
             )
             pat_exp_list
-      | Typedtree.Tstr_primitive (ident, _, _) ->
-          Hashtbl.add table (P (Name.from_ident ident)) tt
+      | Typedtree.Tstr_primitive vd ->
+          Hashtbl.add table (P (Name.from_ident vd.val_id)) tt
       | Typedtree.Tstr_open _ -> ()
       | Typedtree.Tstr_include _ -> ()
       | Typedtree.Tstr_eval _ -> ()
+      | Typedtree.Tstr_attribute _ -> ()
 
     let tables typedtree =
       let t = Hashtbl.create 13 in
@@ -120,27 +121,27 @@ module Typedtree_search =
 
     let search_module table name =
       match Hashtbl.find table (M name) with
-        (Typedtree.Tstr_module (_, _, module_expr)) -> module_expr
+        (Typedtree.Tstr_module mb) -> mb.mb_expr
       | _ -> assert false
 
     let search_module_type table name =
       match Hashtbl.find table (MT name) with
-      | (Typedtree.Tstr_modtype (_, _, module_type)) -> module_type
+      | (Typedtree.Tstr_modtype mtd) -> mtd
       | _ -> assert false
 
     let search_exception table name =
       match Hashtbl.find table (E name) with
-      | (Typedtree.Tstr_exception (_, _, excep_decl)) -> excep_decl
+      | (Typedtree.Tstr_exception decl) -> decl
       | _ -> assert false
 
     let search_exception_rebind table name =
       match Hashtbl.find table (ER name) with
-      | (Typedtree.Tstr_exn_rebind (_, _, p, _)) -> p
+      | (Typedtree.Tstr_exn_rebind (_, _, p, _, _)) -> p
       | _ -> assert false
 
     let search_type_declaration table name =
       match Hashtbl.find table (T name) with
-      | (Typedtree.Tstr_type [(_,_, decl)]) -> decl
+      | (Typedtree.Tstr_type [td]) -> td
       | _ -> assert false
 
     let search_class_exp table name =
@@ -166,14 +167,14 @@ module Typedtree_search =
 
     let search_primitive table name =
       match Hashtbl.find table (P name) with
-        Tstr_primitive (ident, _, val_desc) -> val_desc.val_val.Types.val_type
+        Tstr_primitive vd -> vd.val_val.Types.val_type
       | _ -> assert false
 
     let get_nth_inherit_class_expr cls n =
       let rec iter cpt = function
         | [] ->
             raise Not_found
-        | { cf_desc = Typedtree.Tcf_inher (_, clexp, _, _, _) } :: q ->
+        | { cf_desc = Typedtree.Tcf_inherit (_, clexp, _, _, _) } :: q ->
             if n = cpt then clexp else iter (cpt+1) q
         | _ :: q ->
             iter cpt q
@@ -184,10 +185,10 @@ module Typedtree_search =
       let rec iter = function
         | [] ->
             raise Not_found
-        | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_concrete exp, _) } :: q
+        | { cf_desc = Typedtree.Tcf_val (_, _, ident, Tcfk_concrete (_, exp), _) } :: q
           when Name.from_ident ident = name ->
             exp.Typedtree.exp_type
-        | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_virtual typ, _) } :: q
+        | { cf_desc = Typedtree.Tcf_val (_, _, ident, Tcfk_virtual typ, _) } :: q
           when Name.from_ident ident = name ->
             typ.Typedtree.ctyp_type
         | _ :: q ->
@@ -199,7 +200,7 @@ module Typedtree_search =
       let rec iter = function
         Types.Cty_constr (_, _, cty) -> iter cty
       | Types.Cty_signature s -> s
-      | Types.Cty_fun (_,_, cty) -> iter cty
+      | Types.Cty_arrow (_,_, cty) -> iter cty
       in
       fun ct_decl -> iter ct_decl.Types.clty_type
 
@@ -207,7 +208,7 @@ module Typedtree_search =
       let rec iter = function
         | [] ->
             raise Not_found
-        | { cf_desc = Typedtree.Tcf_meth (label, _, _, Tcfk_concrete exp, _) } :: q when label = name ->
+        | { cf_desc = Typedtree.Tcf_method (label, _, Tcfk_concrete (_, exp)) } :: q when label.txt = name ->
             exp
         | _ :: q ->
             iter q
@@ -265,7 +266,7 @@ module Analyser =
               (List.map iter_pattern patlist,
                Odoc_env.subst_type env pat.pat_type)
 
-        | Typedtree.Tpat_construct (_, cons_desc, _, _) when
+        | Typedtree.Tpat_construct (_, cons_desc, _) when
             (* we give a name to the parameter only if it unit *)
             (match cons_desc.cstr_res.desc with
               Tconstr (p, _, _) ->
@@ -296,13 +297,13 @@ module Analyser =
           (* This case means we have a 'function' without pattern, that's impossible *)
           raise (Failure "tt_analyse_function_parameters: 'function' without pattern")
 
-      | (pattern_param, exp) :: second_ele :: q ->
+      | {c_lhs=pattern_param} :: second_ele :: q ->
           (* implicit pattern matching -> anonymous parameter and no more parameter *)
           (* A VOIR : le label ? *)
           let parameter = Odoc_parameter.Tuple ([], Odoc_env.subst_type env pattern_param.pat_type) in
           [ parameter ]
 
-      | (pattern_param, func_body) :: [] ->
+      | {c_lhs=pattern_param; c_rhs=func_body} :: [] ->
           let parameter =
             tt_param_info_from_pattern
               env
@@ -319,7 +320,8 @@ module Analyser =
                 (
                  (
                   match func_body.exp_desc with
-                    Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, func_body2) ->
+                    Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _) };
+                                            vb_expr=exp} :: _, func_body2) ->
                       let name = Name.from_ident id in
                       let new_param = Simple_name
                           { sn_name = name ;
@@ -450,7 +452,7 @@ module Analyser =
                  [] ->
                    (* cas impossible, on l'a filtre avant *)
                    assert false
-               | (pattern_param, exp) :: second_ele :: q ->
+               | {c_lhs=pattern_param} :: second_ele :: q ->
                    (* implicit pattern matching -> anonymous parameter *)
                    (* Note : We can't match this pattern if it is the first call to the function. *)
                    let new_param = Simple_name
@@ -459,7 +461,7 @@ module Analyser =
                    in
                    [ new_param ]
 
-               | (pattern_param, body) :: [] ->
+               | {c_lhs=pattern_param; c_rhs=body} :: [] ->
                    (* if this is the first call to the function, this is the first parameter and we skip it *)
                    if not first then
                      (
@@ -478,7 +480,8 @@ module Analyser =
                             (
                              (
                               match body.exp_desc with
-                                Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, body2) ->
+                                Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _) };
+                                                        vb_expr=exp} :: _, body2) ->
                                   let name = Name.from_ident id in
                                   let new_param = Simple_name
                                       { sn_name = name ;
@@ -527,7 +530,7 @@ module Analyser =
           | item :: q ->
               let loc = item.Parsetree.pcf_loc in
               match item.Parsetree.pcf_desc with
-        | (Parsetree.Pcf_inher (_, p_clexp, _))  ->
+        | (Parsetree.Pcf_inherit (_, p_clexp, _))  ->
             let tt_clexp =
               let n = List.length acc_inher in
               try Typedtree_search.get_nth_inherit_class_expr tt_cls n
@@ -554,9 +557,8 @@ module Analyser =
               p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
               q
 
-      | ((Parsetree.Pcf_val ({ txt = label }, mutable_flag, _, _) |
-          Parsetree.Pcf_valvirt ({ txt = label }, mutable_flag, _) ) as x) ->
-            let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in
+      | Parsetree.Pcf_val ({ txt = label }, mutable_flag, k) ->
+            let virt = match k with Parsetree.Cfk_virtual _ -> true | Parsetree.Cfk_concrete _ -> false in
             let complete_name = Name.concat current_class_name label in
             let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let type_exp =
@@ -587,7 +589,7 @@ module Analyser =
           in
           iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q
 
-        | (Parsetree.Pcf_virt  ({ txt = label }, private_flag, _)) ->
+        | (Parsetree.Pcf_method  ({ txt = label }, private_flag, Parsetree.Cfk_virtual _)) ->
             let complete_name = Name.concat current_class_name label in
             let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let met_type =
@@ -629,7 +631,7 @@ module Analyser =
 
           iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
 
-        | (Parsetree.Pcf_meth ({ txt = label }, private_flag, _, _)) ->
+        | (Parsetree.Pcf_method ({ txt = label }, private_flag, Parsetree.Cfk_concrete _)) ->
             let complete_name = Name.concat current_class_name label in
             let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let exp =
@@ -670,12 +672,14 @@ module Analyser =
 
           iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
 
-        | Parsetree.Pcf_constr (_, _) ->
+        | Parsetree.Pcf_constraint (_, _) ->
             (* don't give a $*%@ ! *)
             iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
 
-        | (Parsetree.Pcf_init exp) ->
+        | (Parsetree.Pcf_initializer exp) ->
             iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q
+
+        | Parsetree.Pcf_extension _ -> assert false
       in
       iter [] [] last_pos (p_cls.Parsetree.pcstr_fields)
 
@@ -739,7 +743,8 @@ module Analyser =
                  (
                   (* there must be a Tcl_let just after *)
                   match tt_class_expr2.Typedtree.cl_desc with
-                    Typedtree.Tcl_let (_, ({pat_desc = Typedtree.Tpat_var (id,_) } , exp) :: _, _, tt_class_expr3) ->
+                    Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_) };
+                                           vb_expr=exp} :: _, _, tt_class_expr3) ->
                       let name = Name.from_ident id in
                       let new_param = Simple_name
                           { sn_name = name ;
@@ -885,7 +890,7 @@ module Analyser =
     let tt_get_included_module_list tt_structure =
       let f acc item =
         match item.str_desc with
-          Typedtree.Tstr_include (mod_expr, _) ->
+          Typedtree.Tstr_include (mod_expr, _, _) ->
             acc @ [
                   { (* A VOIR : chercher dans les modules et les module types, avec quel env ? *)
                     im_name = tt_name_from_module_expr mod_expr ;
@@ -1054,6 +1059,9 @@ module Analyser =
         Parsetree.Pstr_eval _ ->
           (* don't care *)
           (0, env, [])
+      | Parsetree.Pstr_attribute _
+      | Parsetree.Pstr_extension _ ->
+          (0, env, [])
       | Parsetree.Pstr_value (rec_flag, pat_exp_list) ->
           (* of rec_flag * (pattern * expression) list *)
           (* For each value, look for the value name, then look in the
@@ -1070,7 +1078,7 @@ module Analyser =
             match p_e_list with
               [] ->
                 (acc_env, acc)
-            | (pat, exp) :: q ->
+            | {Parsetree.pvb_pat=pat; pvb_expr=exp} :: q ->
                 let value_name_opt = iter_pat pat.Parsetree.ppat_desc in
                 let new_last_pos = exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum in
                 match value_name_opt with
@@ -1116,7 +1124,8 @@ module Analyser =
           let (new_env, l_ele) = iter ~first: true loc.Location.loc_start.Lexing.pos_cnum env [] pat_exp_list in
           (0, new_env, l_ele)
 
-      | Parsetree.Pstr_primitive ({ txt = name_pre }, val_desc) ->
+      | Parsetree.Pstr_primitive val_desc ->
+            let name_pre = val_desc.Parsetree.pval_name.txt in
             (* of string * value_description *)
             print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]");
             let typ = Typedtree_search.search_primitive table name_pre in
@@ -1147,7 +1156,7 @@ module Analyser =
           (* we start by extending the environment *)
           let new_env =
             List.fold_left
-              (fun acc_env -> fun ({ txt = name }, _) ->
+              (fun acc_env {Parsetree.ptype_name = { txt = name }} ->
                 let complete_name = Name.concat current_module_name name in
                 Odoc_env.add_type acc_env complete_name
               )
@@ -1157,7 +1166,8 @@ module Analyser =
           let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list =
             match name_type_decl_list with
               [] -> (maybe_more_acc, [])
-            | ({ txt = name }, type_decl) :: q ->
+            | type_decl :: q ->
+                let name = type_decl.Parsetree.ptype_name.txt in
                 let complete_name = Name.concat current_module_name name in
                 let loc = type_decl.Parsetree.ptype_loc in
                 let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
@@ -1165,7 +1175,7 @@ module Analyser =
                 let pos_limit2 =
                   match q with
                       [] -> pos_limit
-                    | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
+                    | td :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let (maybe_more, name_comment_list) =
                     Sig.name_comment_from_type_kind
@@ -1228,7 +1238,8 @@ module Analyser =
             let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in
             (maybe_more, new_env, eles)
 
-      | Parsetree.Pstr_exception (name, excep_decl) ->
+      | Parsetree.Pstr_exception excep_decl ->
+          let name = excep_decl.Parsetree.pcd_name in
           (* a new exception is defined *)
           let complete_name = Name.concat current_module_name name.txt in
           (* we get the exception declaration in the typed tree *)
@@ -1246,7 +1257,7 @@ module Analyser =
               ex_info = comment_opt ;
               ex_args = List.map (fun ctyp ->
                 Odoc_env.subst_type new_env ctyp.ctyp_type)
-                tt_excep_decl.exn_params ;
+                tt_excep_decl.cd_args;
               ex_alias = None ;
               ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
               ex_code =
@@ -1260,7 +1271,7 @@ module Analyser =
           in
           (0, new_env, [ Element_exception new_ex ])
 
-      | Parsetree.Pstr_exn_rebind (name,  _) ->
+      | Parsetree.Pstr_exn_rebind (name,  _, _) ->
           (* a new exception is defined *)
           let complete_name = Name.concat current_module_name name.txt in
           (* we get the exception rebind in the typed tree *)
@@ -1283,7 +1294,7 @@ module Analyser =
           in
           (0, new_env, [ Element_exception new_ex ])
 
-      | Parsetree.Pstr_module (name, module_expr) ->
+      | Parsetree.Pstr_module {Parsetree.pmb_name=name; pmb_expr=module_expr} ->
           (
            (* of string * module_expr *)
            try
@@ -1330,7 +1341,7 @@ module Analyser =
              dans les contraintes sur les modules *)
           let new_env =
             List.fold_left
-              (fun acc_env (name, _, mod_exp) ->
+              (fun acc_env {Parsetree.pmb_name=name;pmb_expr=mod_exp} ->
                 let complete_name = Name.concat current_module_name name.txt in
                 let e = Odoc_env.add_module acc_env complete_name in
                 let tt_mod_exp =
@@ -1358,7 +1369,7 @@ module Analyser =
           let rec f ?(first=false) last_pos name_mod_exp_list =
             match name_mod_exp_list with
               [] -> []
-            | (name, _, mod_exp) :: q ->
+            | {Parsetree.pmb_name=name;pmb_expr=mod_exp} :: q ->
                 let complete_name = Name.concat current_module_name name.txt in
                 let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
                 let loc_end =  mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
@@ -1386,39 +1397,44 @@ module Analyser =
           let eles = f ~first: true loc.Location.loc_start.Lexing.pos_cnum mods in
           (0, new_env, eles)
 
-      | Parsetree.Pstr_modtype (name, modtype) ->
+      | Parsetree.Pstr_modtype {Parsetree.pmtd_name=name; pmtd_type=modtype} ->
           let complete_name = Name.concat current_module_name name.txt in
           let tt_module_type =
             try Typedtree_search.search_module_type table name.txt
             with Not_found ->
               raise (Failure (Odoc_messages.module_type_not_found_in_typedtree complete_name))
           in
-          let kind = Sig.analyse_module_type_kind env complete_name
-              modtype tt_module_type.mty_type
+          let kind, sig_mtype =
+            match modtype, tt_module_type.mtd_type with
+            | Some modtype, Some mty_type ->
+                Some (Sig.analyse_module_type_kind env complete_name
+                        modtype mty_type.mty_type),
+                Some mty_type.mty_type
+            | _ -> None, None
           in
           let mt =
             {
               mt_name = complete_name ;
               mt_info = comment_opt ;
-              mt_type = Some tt_module_type.mty_type ;
+              mt_type = sig_mtype ;
               mt_is_interface = false ;
               mt_file = !file_name ;
-              mt_kind = Some kind ;
+              mt_kind = kind ;
               mt_loc = { loc_impl = Some loc ; loc_inter = None } ;
             }
           in
           let new_env = Odoc_env.add_module_type env mt.mt_name in
           let new_env2 =
-            match tt_module_type.mty_type with
+            match sig_mtype with
               (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on n'aurait pas la signature *)
-              Types.Mty_signature s ->
+              Some (Types.Mty_signature s) ->
                 Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
             | _ ->
                 new_env
           in
           (0, new_env2, [ Element_module_type mt ])
 
-      | Parsetree.Pstr_open (_, longident) ->
+      | Parsetree.Pstr_open (_ovf, longident, _attrs) ->
           (* A VOIR : enrichir l'environnement quand open ? *)
           let ele_comments = match comment_opt with
             None -> []
@@ -1528,7 +1544,7 @@ module Analyser =
           in
           (0, new_env, f ~first: true loc.Location.loc_start.Lexing.pos_cnum class_type_decl_list)
 
-      | Parsetree.Pstr_include module_expr ->
+      | Parsetree.Pstr_include (module_expr, _attrs) ->
           (* we add a dummy included module which will be replaced by a correct
              one at the end of the module analysis,
              to use the Path.t of the included modules in the typdtree. *)
diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli
index f1237f11f..dc5a2a3ff 100644
--- a/ocamldoc/odoc_ast.mli
+++ b/ocamldoc/odoc_ast.mli
@@ -33,12 +33,12 @@ module Typedtree_search :
       (** This function returns the [Types.module_type] associated to the given module type name,
          in the given table.
          @raise Not_found if the module type was not found.*)
-      val search_module_type : tab -> string -> Typedtree.module_type
+      val search_module_type : tab -> string -> Typedtree.module_type_declaration
 
       (** This function returns the [Types.exception_declaration] associated to the given exception name,
          in the given table.
          @raise Not_found if the exception was not found.*)
-      val search_exception : tab -> string -> Typedtree.exception_declaration
+      val search_exception : tab -> string -> Typedtree.constructor_declaration
 
       (** This function returns the [Path.t] associated to the given exception rebind name,
          in the table.
diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml
index f4d1b7ce1..d6a595bd7 100644
--- a/ocamldoc/odoc_env.ml
+++ b/ocamldoc/odoc_env.ml
@@ -238,9 +238,9 @@ let subst_class_type env t =
     | Types.Cty_signature cs ->
         (* on ne s'occupe pas des vals et methods *)
         t
-    | Types.Cty_fun (l, texp, ct) ->
+    | Types.Cty_arrow (l, texp, ct) ->
         let new_texp = subst_type env texp in
         let new_ct = iter ct in
-        Types.Cty_fun (l, new_texp, new_ct)
+        Types.Cty_arrow (l, new_texp, new_ct)
   in
   iter t
diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml
index a62832fdb..d09bc9324 100644
--- a/ocamldoc/odoc_print.ml
+++ b/ocamldoc/odoc_print.ml
@@ -90,9 +90,9 @@ let simpl_class_type t =
                                Types.cty_concr = Types.Concr.empty ;
                                Types.cty_inher = []
                              }
-    | Types.Cty_fun (l, texp, ct) ->
+    | Types.Cty_arrow (l, texp, ct) ->
         let new_ct = iter ct in
-        Types.Cty_fun (l, texp, new_ct)
+        Types.Cty_arrow (l, texp, new_ct)
   in
   iter t
 
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index 24beb0288..da70778c4 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -175,37 +175,37 @@ module Analyser =
           (0, [])
       | Parsetree.Ptype_variant cons_core_type_list_list ->
           let rec f acc cons_core_type_list_list =
+            let open Parsetree in
             match cons_core_type_list_list with
               [] ->
                 (0, acc)
-            | (name, _, _, loc) :: [] ->
+            | pcd :: [] ->
                 let s = get_string_of_file
-                    loc.Location.loc_end.Lexing.pos_cnum
+                    pcd.pcd_loc.Location.loc_end.Lexing.pos_cnum
                     pos_limit
                 in
                 let (len, comment_opt) =  My_ir.just_after_special !file_name s in
-                (len, acc @ [ (name.txt, comment_opt) ])
-            | (name, _, _, loc) :: (name2, core_type_list2, ret_type2, loc2)
-              :: q ->
-                let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in
-                let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in
+                (len, acc @ [ (pcd.pcd_name.txt, comment_opt) ])
+            | pcd :: (pcd2 :: _ as q) ->
+                let pos_end_first = pcd.pcd_loc.Location.loc_end.Lexing.pos_cnum in
+                let pos_start_second = pcd2.pcd_loc.Location.loc_start.Lexing.pos_cnum in
                 let s = get_string_of_file pos_end_first pos_start_second in
                 let (_,comment_opt) = My_ir.just_after_special !file_name  s in
-                f (acc @ [name.txt, comment_opt])
-                  ((name2, core_type_list2, ret_type2, loc2) :: q)
+                f (acc @ [pcd.pcd_name.txt, comment_opt]) q
           in
           f [] cons_core_type_list_list
 
       | Parsetree.Ptype_record name_mutable_type_list (* of (string * mutable_flag * core_type) list*) ->
+          let open Parsetree in
           let rec f = function
               [] ->
                 []
-            | (name, _, ct, xxloc) :: [] ->
+            | {pld_name=name; pld_type=ct} :: [] ->
                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
                 let s = get_string_of_file pos pos_end in
                 let (_,comment_opt) =  My_ir.just_after_special !file_name s in
                 [name.txt, comment_opt]
-            | (name,_,ct,xxloc) :: ((name2,_,ct2,xxloc2) as ele2) :: q ->
+            | {pld_name=name; pld_type=ct} :: ({pld_name=name2; pld_type=ct2} as ele2) :: q ->
                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
                 let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
                 let s = get_string_of_file pos pos2 in
@@ -257,11 +257,12 @@ module Analyser =
           Odoc_type.Type_record (List.map f l)
 
     let erased_names_of_constraints constraints acc =
-      List.fold_right (fun (longident, constraint_) acc ->
+      List.fold_right (fun constraint_ acc ->
         match constraint_ with
         | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc
-        | Parsetree.Pwith_typesubst _ | Parsetree.Pwith_modsubst _ ->
-          Name.Set.add (Name.from_longident longident.txt) acc)
+        | Parsetree.Pwith_typesubst {Parsetree.ptype_name=s}
+        | Parsetree.Pwith_modsubst (s, _) ->
+          Name.Set.add s.txt acc)
         constraints acc
 
     let filter_out_erased_items_from_signature erased signature =
@@ -269,21 +270,23 @@ module Analyser =
       else List.fold_right (fun sig_item acc ->
         let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
         match sig_item.Parsetree.psig_desc with
-        | Parsetree.Psig_value (_, _)
-        | Parsetree.Psig_exception (_, _)
+        | Parsetree.Psig_attribute _
+        | Parsetree.Psig_extension _
+        | Parsetree.Psig_value _
+        | Parsetree.Psig_exception _
         | Parsetree.Psig_open _
         | Parsetree.Psig_include _
         | Parsetree.Psig_class _
         | Parsetree.Psig_class_type _ as tp -> take_item tp
         | Parsetree.Psig_type types ->
-          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) types with
+          (match List.filter (fun td -> not (Name.Set.mem td.Parsetree.ptype_name.txt erased)) types with
           | [] -> acc
           | types -> take_item (Parsetree.Psig_type types))
-        | Parsetree.Psig_module (name, _)
-        | Parsetree.Psig_modtype (name, _) as m ->
+        | Parsetree.Psig_module {Parsetree.pmd_name=name}
+        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
           if Name.Set.mem name.txt erased then acc else take_item m
         | Parsetree.Psig_recmodule mods ->
-          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) mods with
+          (match List.filter (fun pmd -> not (Name.Set.mem pmd.Parsetree.pmd_name.txt erased)) mods with
           | [] -> acc
           | mods -> take_item (Parsetree.Psig_recmodule mods)))
         signature []
@@ -299,11 +302,11 @@ module Analyser =
               let loc = ele2.Parsetree.pctf_loc in
             match ele2.Parsetree.pctf_desc with
               Parsetree.Pctf_val (_, _, _, _)
-            | Parsetree.Pctf_virt (_, _, _)
-            | Parsetree.Pctf_meth (_, _, _)
-            | Parsetree.Pctf_cstr (_, _) -> loc.Location.loc_start.Lexing.pos_cnum
-            | Parsetree.Pctf_inher class_type ->
+            | Parsetree.Pctf_method (_, _, _, _)
+            | Parsetree.Pctf_constraint (_, _) -> loc.Location.loc_start.Lexing.pos_cnum
+            | Parsetree.Pctf_inherit class_type ->
                 class_type.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum
+            | Parsetree.Pctf_extension _ -> assert false
       in
       let get_method name comment_opt private_flag loc q =
         let complete_name = Name.concat current_class_name name in
@@ -400,29 +403,26 @@ module Analyser =
             let (inher_l, eles) = f (pos_end + maybe_more) q in
             (inher_l, eles_comments @ ((Class_attribute att) :: eles))
 
-        | Parsetree.Pctf_virt (name, private_flag, _) ->
-            (* of (string * private_flag * core_type * Location.t) *)
+        | Parsetree.Pctf_method (name, private_flag, virtual_flag, _) ->
+            (* of (string * private_flag * virtual_flag * core_type) *)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let (met, maybe_more) = get_method name comment_opt private_flag loc q in
-            let met2 = { met with met_virtual = true } in
+            let met2 =
+              match virtual_flag with
+              | Concrete -> met
+              | Virtual -> { met with met_virtual = true }
+            in
             let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
             (inher_l, eles_comments @ ((Class_method met2) :: eles))
 
-        | Parsetree.Pctf_meth (name, private_flag, _) ->
-            (* of (string * private_flag * core_type * Location.t) *)
-            let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
-            let (met, maybe_more) = get_method name comment_opt private_flag loc q in
-            let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
-            (inher_l, eles_comments @ ((Class_method met) :: eles))
-
-        | (Parsetree.Pctf_cstr (_, _)) ->
-            (* of (core_type * core_type * Location.t) *)
+        | (Parsetree.Pctf_constraint (_, _)) ->
+            (* of (core_type * core_type) *)
             (* A VOIR : cela correspond aux contraintes, non ? on ne les garde pas pour l'instant *)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let (inher_l, eles) = f loc.Location.loc_end.Lexing.pos_cnum q in
             (inher_l, eles_comments @ eles)
 
-        | Parsetree.Pctf_inher class_type ->
+        | Parsetree.Pctf_inherit class_type ->
             let loc = class_type.Parsetree.pcty_loc in
             let (comment_opt, eles_comments) =
               get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum
@@ -451,16 +451,18 @@ module Analyser =
                   ic
 
               | Parsetree.Pcty_signature _
-              | Parsetree.Pcty_fun _ ->
+              | Parsetree.Pcty_arrow _ ->
                     (* we don't have a name for the class signature, so we call it "object ... end"  *)
                   {
                     ic_name = Odoc_messages.object_end ;
                     ic_class = None ;
                     ic_text = text_opt ;
                   }
+              | Parsetree.Pcty_extension _ -> assert false
             in
             let (inher_l, eles) = f (pos_end + maybe_more) q in
             (inh :: inher_l , eles_comments @ eles)
+        | Parsetree.Pctf_extension _ -> assert false
       in
       f last_pos class_type_field_list
 
@@ -522,7 +524,8 @@ module Analyser =
     and analyse_signature_item_desc env signat table current_module_name
         sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
         match sig_item_desc with
-          Parsetree.Psig_value (name_pre, value_desc) ->
+          Parsetree.Psig_value value_desc ->
+            let name_pre = value_desc.Parsetree.pval_name in
             let type_expr =
               try Signature_search.search_value table name_pre.txt
               with Not_found ->
@@ -553,7 +556,8 @@ module Analyser =
             let new_env = Odoc_env.add_value env v.val_name in
             (maybe_more, new_env, [ Element_value v ])
 
-        | Parsetree.Psig_exception (name, exception_decl) ->
+        | Parsetree.Psig_exception exception_decl ->
+            let name = exception_decl.Parsetree.pcd_name in
             let types_excep_decl =
               try Signature_search.search_exception table name.txt
               with Not_found ->
@@ -588,8 +592,8 @@ module Analyser =
             (* we start by extending the environment *)
             let new_env =
               List.fold_left
-                (fun acc_env -> fun (name, _) ->
-                  let complete_name = Name.concat current_module_name name.txt in
+                (fun acc_env td ->
+                  let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
                   Odoc_env.add_type acc_env complete_name
                 )
                 env
@@ -599,7 +603,8 @@ module Analyser =
               match name_type_decl_list with
                 [] ->
                   (acc_maybe_more, [])
-              | (name, type_decl) :: q ->
+              | type_decl :: q ->
+                  let name = type_decl.Parsetree.ptype_name in
                   let (assoc_com, ele_comments) =
                     if first then
                       (comment_opt, [])
@@ -611,7 +616,7 @@ module Analyser =
                   let pos_limit2 =
                     match q with
                       [] -> pos_limit
-                    | ( _, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
+                    | td :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let (maybe_more, name_comment_list) =
                     name_comment_from_type_kind
@@ -685,7 +690,7 @@ module Analyser =
             in
             (0, env, ele_comments)
 
-        | Parsetree.Psig_module (name, module_type) ->
+        | Parsetree.Psig_module {Parsetree.pmd_name=name; pmd_type=module_type} ->
             let complete_name = Name.concat current_module_name name.txt in
             (* get the the module type in the signature by the module name *)
             let sig_module_type =
@@ -736,7 +741,7 @@ module Analyser =
             (* we start by extending the environment *)
             let new_env =
               List.fold_left
-                (fun acc_env -> fun ({ txt = name }, _) ->
+                (fun acc_env {Parsetree.pmd_name={txt=name}} ->
                   let complete_name = Name.concat current_module_name name in
                   let e = Odoc_env.add_module acc_env complete_name in
                   (* get the information for the module in the signature *)
@@ -760,7 +765,7 @@ module Analyser =
               match name_mtype_list with
                 [] ->
                   (acc_maybe_more, [])
-              | (name, modtype) :: q ->
+              | {Parsetree.pmd_name=name; pmd_type=modtype} :: q ->
                   let complete_name = Name.concat current_module_name name.txt in
                   let loc = modtype.Parsetree.pmty_loc in
                   let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
@@ -776,7 +781,7 @@ module Analyser =
                   let pos_limit2 =
                     match q with
                       [] -> pos_limit
-                    | (_, mty) :: _ -> loc.Location.loc_start.Lexing.pos_cnum
+                    | _ :: _ -> loc.Location.loc_start.Lexing.pos_cnum
                   in
                   (* get the information for the module in the signature *)
                   let sig_module_type =
@@ -826,7 +831,7 @@ module Analyser =
             let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
             (maybe_more, new_env, mods)
 
-        | Parsetree.Psig_modtype (name, pmodtype_decl) ->
+        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl} ->
             let complete_name = Name.concat current_module_name name.txt in
             let sig_mtype =
               try Signature_search.search_module_type table name.txt
@@ -835,8 +840,8 @@ module Analyser =
             in
             let module_type_kind =
               match pmodtype_decl with
-                Parsetree.Pmodtype_abstract -> None
-              | Parsetree.Pmodtype_manifest module_type ->
+                None -> None
+              | Some module_type ->
                 match sig_mtype with
                 | Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
                 | None -> None
@@ -867,7 +872,7 @@ module Analyser =
             in
             (maybe_more, new_env2, [ Element_module_type mt ])
 
-        | Parsetree.Psig_include module_type ->
+        | Parsetree.Psig_include (module_type, _attrs) ->
             let rec f = function
                 Parsetree.Pmty_ident longident ->
                   Name.from_longident longident.txt
@@ -878,9 +883,11 @@ module Analyser =
               | Parsetree.Pmty_with (mt, _) ->
                   f mt.Parsetree.pmty_desc
               | Parsetree.Pmty_typeof mexpr ->
-                  match mexpr.Parsetree.pmod_desc with
+                  begin match mexpr.Parsetree.pmod_desc with
                     Parsetree.Pmod_ident longident -> Name.from_longident longident.txt
                   | _ -> "??"
+                  end
+              | Parsetree.Pmty_extension _ -> assert false
             in
             let name = f module_type.Parsetree.pmty_desc in
             let full_name = Odoc_env.full_module_or_module_type_name env name in
@@ -1041,6 +1048,9 @@ module Analyser =
               f ~first: true 0 pos_start_ele class_type_declaration_list
             in
             (maybe_more, new_env, eles)
+        | Parsetree.Psig_attribute _
+        | Parsetree.Psig_extension _ ->
+            (0, env, [])
 
     (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
     and analyse_module_type_kind
@@ -1119,6 +1129,8 @@ module Analyser =
           let s = get_string_of_file loc_start loc_end in
           Module_type_typeof s
 
+      | Parsetree.Pmty_extension _ -> assert false
+
     (** analyse of a Parsetree.module_type and a Types.module_type.*)
     and analyse_module_kind
         ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type =
@@ -1191,6 +1203,9 @@ module Analyser =
           let s = get_string_of_file loc_start loc_end in
           Module_typeof s
 
+      | Parsetree.Pmty_extension _ -> assert false
+
+
     (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple
        (class parameters, class_kind).*)
     and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type =
@@ -1220,7 +1235,7 @@ module Analyser =
           in
           ([], Class_structure (inher_l, ele))
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
+      | (Parsetree.Pcty_arrow (parse_label, _, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
           (* label = string. Dans les signatures, pas de nom de parametres a l'interieur des tuples *)
           (* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *)
           if parse_label = label then
@@ -1237,7 +1252,7 @@ module Analyser =
             )
           else
             (
-             raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels differents")
+             raise (Failure "Parsetree.Pcty_arrow (parse_label, _, pclass_type), labels differents")
             )
 
       | _ ->
@@ -1271,8 +1286,8 @@ module Analyser =
           in
           Class_signature (inher_l, ele)
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
-          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Cty_fun (...)")
+      | (Parsetree.Pcty_arrow (parse_label, _, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
+          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_arrow (...) with Types.Cty_arrow (...)")
 (*
       | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
          Types.Cty_signature class_signature) ->
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 5f3a8e9e7..b36ad9596 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -125,7 +125,7 @@ let string_of_class_type_param_list l =
 let string_of_class_params c =
   let b = Buffer.create 256 in
   let rec iter = function
-      Types.Cty_fun (label, t, ctype) ->
+      Types.Cty_arrow (label, t, ctype) ->
         let parent = is_arrow_type t in
         Printf.bprintf b "%s%s%s%s -> "
           (
diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml
index 5450c8616..88cd60f64 100644
--- a/otherlibs/labltk/browser/searchid.ml
+++ b/otherlibs/labltk/browser/searchid.ml
@@ -412,12 +412,13 @@ open Parsetree
 
 let rec bound_variables pat =
   match pat.ppat_desc with
-    Ppat_any | Ppat_constant _ | Ppat_type _ | Ppat_unpack _ -> []
+    Ppat_any | Ppat_constant _ | Ppat_type _ | Ppat_unpack _
+  | Ppat_interval _ -> []
   | Ppat_var s -> [s.txt]
   | Ppat_alias (pat,s) -> s.txt :: bound_variables pat
   | Ppat_tuple l -> List2.flat_map l ~f:bound_variables
-  | Ppat_construct (_,None,_) -> []
-  | Ppat_construct (_,Some pat,_) -> bound_variables pat
+  | Ppat_construct (_,None) -> []
+  | Ppat_construct (_,Some pat) -> bound_variables pat
   | Ppat_variant (_,None) -> []
   | Ppat_variant (_,Some pat) -> bound_variables pat
   | Ppat_record (l, _) ->
@@ -428,6 +429,7 @@ let rec bound_variables pat =
       bound_variables pat1 @ bound_variables pat2
   | Ppat_constraint (pat,_) -> bound_variables pat
   | Ppat_lazy pat -> bound_variables pat
+  | Ppat_extension _ -> []
 
 let search_structure str ~name ~kind ~prefix =
   let loc = ref 0 in
@@ -438,9 +440,9 @@ let search_structure str ~name ~kind ~prefix =
           List.fold_left ~init:[] str ~f:
             begin fun acc item ->
               match item.pstr_desc with
-                Pstr_module (s, mexp) when s.txt = modu ->
-                  loc := mexp.pmod_loc.loc_start.Lexing.pos_cnum;
-                  begin match mexp.pmod_desc with
+                Pstr_module x when x.pmb_name.txt = modu ->
+                  loc := x.pmb_expr.pmod_loc.loc_start.Lexing.pos_cnum;
+                  begin match x.pmb_expr.pmod_desc with
                     Pmod_structure str -> str
                   | _ -> []
                   end
@@ -453,21 +455,21 @@ let search_structure str ~name ~kind ~prefix =
       if match item.pstr_desc with
         Pstr_value (_, l) when kind = Pvalue ->
           List.iter l ~f:
-            begin fun (pat,_) ->
+            begin fun {pvb_pat=pat} ->
               if List.mem name (bound_variables pat)
               then loc := pat.ppat_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_primitive (s, _) when kind = Pvalue -> name = s.txt
+      | Pstr_primitive vd when kind = Pvalue -> name = vd.pval_name.txt
       | Pstr_type l when kind = Ptype ->
           List.iter l ~f:
-            begin fun (s, td) ->
-              if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+            begin fun td ->
+              if td.ptype_name.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_exception (s, _) when kind = Pconstructor -> name = s.txt
-      | Pstr_module (s, _) when kind = Pmodule -> name = s.txt
-      | Pstr_modtype (s, _) when kind = Pmodtype -> name = s.txt
+      | Pstr_exception pcd when kind = Pconstructor -> name = pcd.pcd_name.txt
+      | Pstr_module x when kind = Pmodule -> name = x.pmb_name.txt
+      | Pstr_modtype x when kind = Pmodtype -> name = x.pmtd_name.txt
       | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
           List.iter l ~f:
             begin fun c ->
@@ -498,9 +500,9 @@ let search_signature sign ~name ~kind ~prefix =
           List.fold_left ~init:[] sign ~f:
             begin fun acc item ->
               match item.psig_desc with
-                Psig_module (s, mtyp) when s.txt = modu ->
-                  loc := mtyp.pmty_loc.loc_start.Lexing.pos_cnum;
-                  begin match mtyp.pmty_desc with
+                Psig_module pmd when pmd.pmd_name.txt = modu ->
+                  loc := pmd.pmd_type.pmty_loc.loc_start.Lexing.pos_cnum;
+                  begin match pmd.pmd_type.pmty_desc with
                     Pmty_signature sign -> sign
                   | _ -> []
                   end
@@ -511,16 +513,16 @@ let search_signature sign ~name ~kind ~prefix =
   List.iter (search_module_type sign ~prefix) ~f:
     begin fun item ->
       if match item.psig_desc with
-        Psig_value (s, _) when kind = Pvalue -> name = s.txt
+        Psig_value vd when kind = Pvalue -> name = vd.pval_name.txt
       | Psig_type l when kind = Ptype ->
           List.iter l ~f:
-            begin fun (s, td) ->
-              if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+            begin fun td ->
+              if td.ptype_name.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Psig_exception (s, _) when kind = Pconstructor -> name = s.txt
-      | Psig_module (s, _) when kind = Pmodule -> name = s.txt
-      | Psig_modtype (s, _) when kind = Pmodtype -> name = s.txt
+      | Psig_exception pcd when kind = Pconstructor -> name = pcd.pcd_name.txt
+      | Psig_module pmd when kind = Pmodule -> name = pmd.pmd_name.txt
+      | Psig_modtype pmtd when kind = Pmodtype -> name = pmtd.pmtd_name.txt
       | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
           List.iter l ~f:
             begin fun c ->
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 13847e280..ed2c23acd 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -120,19 +120,16 @@ let rec search_pos_type t ~pos ~env =
   | Ptyp_constr (lid, tl) ->
       List.iter tl ~f:(search_pos_type ~pos ~env);
       add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
-  | Ptyp_object fl ->
-      List.iter fl ~f:
-        begin function
-        | {pfield_desc = Pfield (_, ty)} -> search_pos_type ty ~pos ~env
-        | _ -> ()
-        end
-  | Ptyp_class (lid, tl, _) ->
+  | Ptyp_object (fl, _) ->
+      List.iter fl ~f:(fun (_, ty) -> search_pos_type ty ~pos ~env)
+  | Ptyp_class (lid, tl) ->
       List.iter tl ~f:(search_pos_type ~pos ~env);
       add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
   | Ptyp_alias (t, _)
   | Ptyp_poly (_, t) -> search_pos_type ~pos ~env t
   | Ptyp_package (_, stl) ->
      List.iter stl ~f:(fun (_, ty) -> search_pos_type ty ~pos ~env)
+  | Ptyp_extension _ -> ()
   end
 
 let rec search_pos_class_type cl ~pos ~env =
@@ -143,22 +140,21 @@ let rec search_pos_class_type cl ~pos ~env =
     | Pcty_signature  cl ->
         List.iter cl.pcsig_fields ~f: (fun fl ->
           begin match fl.pctf_desc with
-              Pctf_inher cty -> search_pos_class_type cty ~pos ~env
-            | Pctf_val (_, _, _, ty) ->
-                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_virt (_, _, ty) ->
+              Pctf_inherit cty -> search_pos_class_type cty ~pos ~env
+            | Pctf_val (_, _, _, ty)
+            | Pctf_method (_, _, _, ty) ->
                 if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_meth (_, _, ty) ->
-                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
-            | Pctf_cstr (ty1, ty2) ->
+            | Pctf_constraint (ty1, ty2) ->
                 if in_loc fl.pctf_loc ~pos then begin
                   search_pos_type ty1 ~pos ~env;
                   search_pos_type ty2 ~pos ~env
                 end
+            | Pctf_extension _ -> ()
           end)
-    | Pcty_fun (_, ty, cty) ->
+    | Pcty_arrow (_, ty, cty) ->
         search_pos_type ty ~pos ~env;
         search_pos_class_type cty ~pos ~env
+    | Pcty_extension _ -> ()
     end
 
 let search_pos_type_decl td ~pos ~env =
@@ -171,9 +167,9 @@ let search_pos_type_decl td ~pos ~env =
       Ptype_abstract -> ()
     | Ptype_variant dl ->
         List.iter dl
-          ~f:(fun (_, tl, _, _) -> List.iter tl ~f:(search_pos_type ~pos ~env))
+          ~f:(fun pcd -> List.iter pcd.pcd_args ~f:(search_pos_type ~pos ~env)) (* iter on pcd_res? *)
     | Ptype_record dl ->
-        List.iter dl ~f:(fun (_, _, t, _) -> search_pos_type t ~pos ~env) in
+        List.iter dl ~f:(fun pld -> search_pos_type pld.pld_type ~pos ~env) in
     search_tkind td.ptype_kind;
     List.iter td.ptype_cstrs ~f:
       begin fun (t1, t2, _) ->
@@ -187,7 +183,7 @@ let rec search_pos_signature l ~pos ~env =
   List.fold_left l ~init:env ~f:
   begin fun env pt ->
     let env = match pt.psig_desc with
-      Psig_open (ovf, id) ->
+      Psig_open (ovf, id, _) ->
         let path, mt = lookup_module id.txt env in
         begin match mt with
           Mty_signature sign -> open_signature ovf path sign env
@@ -200,17 +196,17 @@ let rec search_pos_signature l ~pos ~env =
     in
     if in_loc ~pos pt.psig_loc then
       begin match pt.psig_desc with
-        Psig_value (_, desc) -> search_pos_type desc.pval_type ~pos ~env
+        Psig_value desc -> search_pos_type desc.pval_type ~pos ~env
       | Psig_type l ->
-          List.iter l ~f:(fun (_,desc) -> search_pos_type_decl ~pos desc ~env)
-      | Psig_exception (_, l) ->
-          List.iter l ~f:(search_pos_type ~pos ~env);
+          List.iter l ~f:(search_pos_type_decl ~pos ~env)
+      | Psig_exception pcd ->
+          List.iter pcd.pcd_args ~f:(search_pos_type ~pos ~env);
           add_found_sig (`Type, Lident "exn") ~env ~loc:pt.psig_loc
-      | Psig_module (_, t) ->
-          search_pos_module t ~pos ~env
+      | Psig_module pmd ->
+          search_pos_module pmd.pmd_type ~pos ~env
       | Psig_recmodule decls ->
-          List.iter decls ~f:(fun (_, t) -> search_pos_module t ~pos ~env)
-      | Psig_modtype (_, Pmodtype_manifest t) ->
+          List.iter decls ~f:(fun pmd -> search_pos_module pmd.pmd_type ~pos ~env)
+      | Psig_modtype {pmtd_type=Some t} ->
           search_pos_module t ~pos ~env
       | Psig_modtype _ -> ()
       | Psig_class l ->
@@ -220,9 +216,10 @@ let rec search_pos_signature l ~pos ~env =
           List.iter l
             ~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
       (* The last cases should not happen in generated interfaces *)
-      | Psig_open (_, lid) ->
+      | Psig_open (_, lid, _) ->
         add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
-      | Psig_include t -> search_pos_module t ~pos ~env
+      | Psig_include (t, _) -> search_pos_module t ~pos ~env
+      | Psig_attribute _ | Psig_extension _ -> ()
       end;
     env
   end)
@@ -239,11 +236,12 @@ and search_pos_module m ~pos ~env =
         search_pos_module m ~pos ~env;
         List.iter l ~f:
           begin function
-              _, Pwith_type t -> search_pos_type_decl t ~pos ~env
+              Pwith_type (_, t) -> search_pos_type_decl t ~pos ~env
             | _ -> ()
           end
     | Pmty_typeof md ->
         ()   (* TODO? *)
+    | Pmty_extension _ -> ()
     end
   end
 
@@ -662,41 +660,43 @@ let add_found_str = add_found ~found:found_str
 let rec search_pos_structure ~pos str =
   List.iter str ~f:
   begin function str -> match str.str_desc with
-    Tstr_eval exp -> search_pos_expr exp ~pos
+    Tstr_eval (exp, _) -> search_pos_expr exp ~pos
   | Tstr_value (rec_flag, l) ->
       List.iter l ~f:
-      begin fun (pat, exp) ->
+      begin fun {vb_pat=pat;vb_expr=exp} ->
         let env =
           if rec_flag = Asttypes.Recursive then exp.exp_env else Env.empty in
         search_pos_pat pat ~pos ~env;
         search_pos_expr exp ~pos
       end
-  | Tstr_primitive (_, _, vd) ->()
-  | Tstr_type _ -> ()
-  | Tstr_exception _ -> ()
-  | Tstr_exn_rebind(_, _, _, _) -> ()
-  | Tstr_module (_, _, m) -> search_pos_module_expr m ~pos
+  | Tstr_module mb -> search_pos_module_expr mb.mb_expr ~pos
   | Tstr_recmodule bindings ->
-      List.iter bindings ~f:(fun (_, _, _, m) -> search_pos_module_expr m ~pos)
-  | Tstr_modtype _ -> ()
-  | Tstr_open _ -> ()
+      List.iter bindings ~f:(fun mb -> search_pos_module_expr mb.mb_expr ~pos)
   | Tstr_class l ->
       List.iter l ~f:(fun (cl, _, _) -> search_pos_class_expr cl.ci_expr ~pos)
-  | Tstr_class_type _ -> ()
-  | Tstr_include (m, _) -> search_pos_module_expr m ~pos
+  | Tstr_include (m, _, _) -> search_pos_module_expr m ~pos
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_exception _
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_exn_rebind _
+  | Tstr_attribute _
+    -> ()
   end
 
 and search_pos_class_structure ~pos cls =
   List.iter cls.cstr_fields ~f:
     begin function cf -> match cf.cf_desc with
-        Tcf_inher (_, cl, _, _, _) ->
+        Tcf_inherit (_, cl, _, _, _) ->
           search_pos_class_expr cl ~pos
-      | Tcf_val (_, _, _, _, Tcfk_concrete exp, _) -> search_pos_expr exp ~pos
+      | Tcf_val (_, _, _, Tcfk_concrete (_, exp), _) -> search_pos_expr exp ~pos
       | Tcf_val _ -> ()
-      | Tcf_meth (_, _, _, Tcfk_concrete exp, _) -> search_pos_expr exp ~pos
-      | Tcf_init exp -> search_pos_expr exp ~pos
-      | Tcf_constr _
-      | Tcf_meth _
+      | Tcf_method (_, _, Tcfk_concrete (_, exp)) -> search_pos_expr exp ~pos
+      | Tcf_initializer exp -> search_pos_expr exp ~pos
+      | Tcf_constraint _
+      | Tcf_method _
         -> assert false (* TODO !!!!!!!!!!!!!!!!! *)
     end
 
@@ -717,7 +717,7 @@ and search_pos_class_expr ~pos cl =
         List.iter el ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x)
     | Tcl_let (_, pel, iel, cl) ->
         List.iter pel ~f:
-          begin fun (pat, exp) ->
+          begin fun {vb_pat=pat; vb_expr=exp} ->
             search_pos_pat pat ~pos ~env:exp.exp_env;
             search_pos_expr exp ~pos
           end;
@@ -730,6 +730,14 @@ and search_pos_class_expr ~pos cl =
       ~env:!start_env ~loc:cl.cl_loc
   end
 
+and search_case ~pos {c_lhs; c_guard; c_rhs} =
+  search_pos_pat c_lhs ~pos ~env:c_rhs.exp_env;
+  begin match c_guard with
+  | None -> ()
+  | Some g -> search_pos_expr g ~pos
+  end;
+  search_pos_expr c_rhs ~pos
+
 and search_pos_expr ~pos exp =
   if in_loc exp.exp_loc ~pos then begin
   begin match exp.exp_desc with
@@ -741,36 +749,24 @@ and search_pos_expr ~pos exp =
         ~env:exp.exp_env ~loc:exp.exp_loc
   | Texp_let (_, expl, exp) ->
       List.iter expl ~f:
-      begin fun (pat, exp') ->
+      begin fun {vb_pat=pat; vb_expr=exp'} ->
         search_pos_pat pat ~pos ~env:exp.exp_env;
         search_pos_expr exp' ~pos
       end;
       search_pos_expr exp ~pos
   | Texp_function (_, l, _) ->
-      List.iter l ~f:
-      begin fun (pat, exp) ->
-        search_pos_pat pat ~pos ~env:exp.exp_env;
-        search_pos_expr exp ~pos
-      end
+      List.iter l ~f:(search_case ~pos)
   | Texp_apply (exp, l) ->
       List.iter l ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x);
       search_pos_expr exp ~pos
   | Texp_match (exp, l, _) ->
       search_pos_expr exp ~pos;
-      List.iter l ~f:
-      begin fun (pat, exp) ->
-        search_pos_pat pat ~pos ~env:exp.exp_env;
-        search_pos_expr exp ~pos
-      end
+      List.iter l ~f:(search_case ~pos)
   | Texp_try (exp, l) ->
       search_pos_expr exp ~pos;
-      List.iter l ~f:
-      begin fun (pat, exp) ->
-        search_pos_pat pat ~pos ~env:exp.exp_env;
-        search_pos_expr exp ~pos
-      end
+      List.iter l ~f:(search_case ~pos)
   | Texp_tuple l -> List.iter l ~f:(search_pos_expr ~pos)
-  | Texp_construct (_, _, l,_) -> List.iter l ~f:(search_pos_expr ~pos)
+  | Texp_construct (_, _, l) -> List.iter l ~f:(search_pos_expr ~pos)
   | Texp_variant (_, None) -> ()
   | Texp_variant (_, Some exp) -> search_pos_expr exp ~pos
   | Texp_record (l, opt) ->
@@ -791,8 +787,6 @@ and search_pos_expr ~pos exp =
       search_pos_expr a ~pos; search_pos_expr b ~pos
   | Texp_for (_, _, a, b, _, c) ->
       List.iter [a;b;c] ~f:(search_pos_expr ~pos)
-  | Texp_when (a, b) ->
-      search_pos_expr a ~pos; search_pos_expr b ~pos
   | Texp_send (exp, _, _) -> search_pos_expr exp ~pos
   | Texp_new (path, _, _) ->
       add_found_str (`Exp(`New path, exp.exp_type))
@@ -809,7 +803,6 @@ and search_pos_expr ~pos exp =
   | Texp_letmodule (id, _, modexp, exp) ->
       search_pos_module_expr modexp ~pos;
       search_pos_expr exp ~pos
-  | Texp_assertfalse -> ()
   | Texp_assert exp ->
       search_pos_expr exp ~pos
   | Texp_lazy exp ->
@@ -835,7 +828,7 @@ and search_pos_pat ~pos ~env pat =
       add_found_str (`Exp(`Const, pat.pat_type)) ~env ~loc:pat.pat_loc
   | Tpat_tuple l ->
       List.iter l ~f:(search_pos_pat ~pos ~env)
-  | Tpat_construct (_, _, l, _) ->
+  | Tpat_construct (_, _, l) ->
       List.iter l ~f:(search_pos_pat ~pos ~env)
   | Tpat_variant (_, None, _) -> ()
   | Tpat_variant (_, Some pat, _) -> search_pos_pat pat ~pos ~env
diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
new file mode 100644
index 000000000..6bb01d953
--- /dev/null
+++ b/parsing/ast_helper.ml
@@ -0,0 +1,426 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Helpers to produce Parsetree fragments *)
+
+open Asttypes
+open Parsetree
+
+type lid = Longident.t loc
+type str = string loc
+type loc = Location.t
+type attrs = attribute list
+
+let default_loc = ref Location.none
+
+let with_default_loc l f =
+  let old = !default_loc in
+  default_loc := l;
+  try let r = f () in default_loc := old; r
+  with exn -> default_loc := old; raise exn
+
+module Typ = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs}
+  let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]}
+
+  let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
+  let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
+  let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
+  let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
+  let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
+
+  let force_poly t =
+    match t.ptyp_desc with
+    | Ptyp_poly _ -> t
+    | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *)
+end
+
+module Pat = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs}
+  let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]}
+
+  let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
+  let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+  let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a)
+  let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b))
+  let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)
+  let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
+end
+
+module Exp = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs}
+  let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]}
+
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
+  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d))
+  let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a)
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
+  let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
+  let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)
+  let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))
+  let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))
+  let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)
+  let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))
+  let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))
+  let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))
+  let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))
+  let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c))
+  let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b))
+  let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a)
+  let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))
+  let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)
+  let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c))
+  let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
+  let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
+  let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
+  let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
+  let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+
+  let case lhs ?guard rhs =
+    {
+     pc_lhs = lhs;
+     pc_guard = guard;
+     pc_rhs = rhs;
+    }
+end
+
+module Mty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs}
+  let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]}
+
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
+  let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c))
+  let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
+  let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)
+end
+
+module Mod = struct
+let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}
+  let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]}
+
+  let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
+  let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)
+  let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body))
+  let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
+  let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
+  let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
+end
+
+module Sig = struct
+  let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc}
+
+  let value ?loc a = mk ?loc (Psig_value a)
+  let type_ ?loc a = mk ?loc (Psig_type a)
+  let exception_ ?loc a = mk ?loc (Psig_exception a)
+  let module_ ?loc a = mk ?loc (Psig_module a)
+  let rec_module ?loc a = mk ?loc (Psig_recmodule a)
+  let modtype ?loc a = mk ?loc (Psig_modtype a)
+  let open_ ?loc ?(attrs = []) a b = mk ?loc (Psig_open (a, b, attrs))
+  let include_ ?loc ?(attrs = []) a = mk ?loc (Psig_include (a, attrs))
+  let class_ ?loc a = mk ?loc (Psig_class a)
+  let class_type ?loc a = mk ?loc (Psig_class_type a)
+  let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Psig_attribute a)
+end
+
+module Str = struct
+  let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}
+
+  let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))
+  let value ?loc a b = mk ?loc (Pstr_value (a, b))
+  let primitive ?loc a = mk ?loc (Pstr_primitive a)
+  let type_ ?loc a = mk ?loc (Pstr_type a)
+  let exception_ ?loc a = mk ?loc (Pstr_exception a)
+  let exn_rebind ?loc ?(attrs = []) a b = mk ?loc (Pstr_exn_rebind (a, b, attrs))
+  let module_ ?loc a = mk ?loc (Pstr_module a)
+  let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
+  let modtype ?loc a = mk ?loc (Pstr_modtype a)
+  let open_ ?loc ?(attrs = []) a b = mk ?loc (Pstr_open (a, b, attrs))
+  let class_ ?loc a = mk ?loc (Pstr_class a)
+  let class_type ?loc a = mk ?loc (Pstr_class_type a)
+  let include_ ?loc ?(attrs = []) a = mk ?loc (Pstr_include (a, attrs))
+  let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Pstr_attribute a)
+end
+
+module Cl = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pcl_desc = d;
+     pcl_loc = loc;
+     pcl_attributes = attrs;
+    }
+  let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]}
+
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b))
+  let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a)
+  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d))
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b))
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a)
+end
+
+module Cty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pcty_desc = d;
+     pcty_loc = loc;
+     pcty_attributes = attrs;
+    }
+  let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]}
+
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b))
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a)
+end
+
+module Ctf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pctf_desc = d;
+     pctf_loc = loc;
+     pctf_attributes = attrs;
+    }
+  let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
+
+  let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)
+  let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))
+  let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
+end
+
+module Cf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+     pcf_desc = d;
+     pcf_loc = loc;
+     pcf_attributes = attrs;
+    }
+  let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}
+
+  let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))
+  let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))
+  let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))
+  let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
+
+  let virtual_ ct = Cfk_virtual ct
+  let concrete o e = Cfk_concrete (o, e)
+end
+
+module Val = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(prim = []) name typ =
+    {
+     pval_name = name;
+     pval_type = typ;
+     pval_attributes = attrs;
+     pval_loc = loc;
+     pval_prim = prim;
+    }
+end
+
+module Md = struct
+  let mk ?(attrs = []) name typ =
+    {
+     pmd_name = name;
+     pmd_type = typ;
+     pmd_attributes = attrs;
+    }
+end
+
+module Mtd = struct
+  let mk ?(attrs = []) ?typ name =
+    {
+     pmtd_name = name;
+     pmtd_type = typ;
+     pmtd_attributes = attrs;
+    }
+end
+
+module Mb = struct
+  let mk ?(attrs = []) name expr =
+    {
+     pmb_name = name;
+     pmb_expr = expr;
+     pmb_attributes = attrs;
+    }
+end
+
+module Vb = struct
+  let mk ?(attrs = []) pat expr =
+    {
+     pvb_pat = pat;
+     pvb_expr = expr;
+     pvb_attributes = attrs;
+    }
+end
+
+module Ci = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(virt = Concrete) ?(params = []) name expr =
+    {
+     pci_virt = virt;
+     pci_params = params;
+     pci_name = name;
+     pci_expr = expr;
+     pci_attributes = attrs;
+     pci_loc = loc;
+    }
+end
+
+module Type = struct
+  let mk ?(loc = !default_loc) ?(attrs = [])
+      ?(params = [])
+      ?(cstrs = [])
+      ?(kind = Ptype_abstract)
+      ?(priv = Public)
+      ?manifest
+      name =
+    {
+     ptype_name = name;
+     ptype_params = params;
+     ptype_cstrs = cstrs;
+     ptype_kind = kind;
+     ptype_private = priv;
+     ptype_manifest = manifest;
+     ptype_attributes = attrs;
+     ptype_loc = loc;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = []) ?(args = []) ?res name =
+    {
+     pcd_name = name;
+     pcd_args = args;
+     pcd_res = res;
+     pcd_loc = loc;
+     pcd_attributes = attrs;
+    }
+
+  let field ?(loc = !default_loc) ?(attrs = []) ?(mut = Immutable) name typ =
+    {
+     pld_name = name;
+     pld_mutable = mut;
+     pld_type = typ;
+     pld_loc = loc;
+     pld_attributes = attrs;
+    }
+end
+
+module Csig = struct
+  let mk self fields =
+    {
+     pcsig_self = self;
+     pcsig_fields = fields;
+    }
+end
+
+module Cstr = struct
+  let mk self fields =
+    {
+     pcstr_self = self;
+     pcstr_fields = fields;
+    }
+end
+
+module Convenience = struct
+  open Location
+
+  let may_tuple tup = function
+    | [] -> None
+    | [x] -> Some x
+    | l -> Some (tup l)
+
+  let lid s = mkloc (Longident.parse s) !default_loc
+  let tuple l = Exp.tuple l
+  let constr s args = Exp.construct (lid s) (may_tuple Exp.tuple args)
+  let nil () = constr "[]" []
+  let unit () = constr "()" []
+  let cons hd tl = constr "::" [hd; tl]
+  let list l = List.fold_right cons l (nil ())
+  let str s = Exp.constant (Const_string (s, None))
+  let int x = Exp.constant (Const_int x)
+  let char x = Exp.constant (Const_char x)
+  let float x = Exp.constant (Const_float (string_of_float x))
+  let record ?over l =
+    Exp.record (List.map (fun (s, e) -> (lid s, e)) l) over
+  let func l = Exp.function_ (List.map (fun (p, e) -> Exp.case p e) l)
+  let lam ?(label = "") ?default pat exp = Exp.fun_ label default pat exp
+  let app f l = Exp.apply f (List.map (fun a -> "", a) l)
+  let evar s = Exp.ident (lid s)
+  let let_in ?(recursive = false) b body =
+    Exp.let_ (if recursive then Recursive else Nonrecursive) b body
+
+  let pvar s = Pat.var (mkloc s !default_loc)
+  let pconstr s args = Pat.construct (lid s) (may_tuple Pat.tuple args)
+  let punit () = pconstr "()" []
+
+
+  let tconstr c l = Typ.constr (lid c) l
+
+  let get_str = function
+    | {pexp_desc=Pexp_constant (Const_string (s, _)); _} -> Some s
+    | e -> None
+
+  let get_lid = function
+    | {pexp_desc=Pexp_ident{txt=id;_};_} ->
+        Some (String.concat "." (Longident.flatten id))
+    | _ -> None
+
+  let find_attr s attrs =
+    try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs))
+    with Not_found -> None
+
+  let expr_of_payload = function
+    | PStr [{pstr_desc=Pstr_eval(e, _)}] -> Some e
+    | _ -> None
+
+  let find_attr_expr s attrs =
+    match find_attr s attrs with
+    | Some e -> expr_of_payload e
+    | None -> None
+
+  let has_attr s attrs =
+    find_attr s attrs <> None
+end
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
new file mode 100644
index 000000000..329db3616
--- /dev/null
+++ b/parsing/ast_helper.mli
@@ -0,0 +1,366 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Helpers to produce Parsetree fragments *)
+
+open Parsetree
+open Asttypes
+
+type lid = Longident.t loc
+type str = string loc
+type loc = Location.t
+type attrs = attribute list
+
+(** {2 Default locations} *)
+
+val default_loc: loc ref
+    (** Default value for all optional location arguments. *)
+val with_default_loc: loc -> (unit -> 'a) -> 'a
+    (** Set the [default_loc] within the scope of the execution
+        of the provided function. *)
+
+(** {2 Core language} *)
+
+(** Type expressions *)
+module Typ :
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type
+    val attr: core_type -> attribute -> core_type
+
+    val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type
+    val var: ?loc:loc -> ?attrs:attrs -> string -> core_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> core_type -> core_type
+    val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+    val object_: ?loc:loc -> ?attrs:attrs -> (string * core_type) list -> closed_flag -> core_type
+    val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+    val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
+    val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type
+    val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type
+    val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type
+
+    val force_poly: core_type -> core_type
+  end
+
+(** Patterns *)
+module Pat:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern
+    val attr:pattern -> attribute -> pattern
+
+    val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern
+    val var: ?loc:loc -> ?attrs:attrs -> str -> pattern
+    val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
+    val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
+    val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
+    val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+    val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
+    val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
+    val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern
+    val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+    val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
+    val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
+    val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern
+    val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+    val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
+  end
+
+(** Expressions *)
+module Exp:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression
+    val attr: expression -> attribute -> expression
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression
+    val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression
+    val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression
+    val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> expression -> expression
+    val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression
+    val apply: ?loc:loc -> ?attrs:attrs -> expression -> (label * expression) list -> expression
+    val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+    val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+    val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+    val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression
+    val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression
+    val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression
+    val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+    val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression
+    val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+    val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression
+    val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
+    val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
+    val for_: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression -> direction_flag -> expression -> expression
+    val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression
+    val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression
+    val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression
+    val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression
+    val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+    val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression
+    val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression
+    val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+    val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+    val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression
+    val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression
+    val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression
+    val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
+    val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
+
+    val case: pattern -> ?guard:expression -> expression -> case
+  end
+
+(** Value declarations *)
+module Val:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?prim:string list -> str -> core_type -> value_description
+  end
+
+(** Type declarations *)
+module Type:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?params:(str option * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration
+
+    val constructor: ?loc:loc -> ?attrs:attrs -> ?args:core_type list -> ?res:core_type -> str -> constructor_declaration
+    val field: ?loc:loc -> ?attrs:attrs -> ?mut:mutable_flag -> str -> core_type -> label_declaration
+  end
+
+(** {2 Module language} *)
+
+(** Module type expressions *)
+module Mty:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type
+    val attr: module_type -> attribute -> module_type
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+    val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
+    val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_type -> module_type
+    val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type
+    val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
+  end
+
+(** Module expressions *)
+module Mod:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr
+    val attr: module_expr -> attribute -> module_expr
+
+    val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
+    val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
+    val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_expr -> module_expr
+    val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr
+    val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr
+    val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr
+  end
+
+(** Signature items *)
+module Sig:
+  sig
+    val mk: ?loc:loc -> signature_item_desc -> signature_item
+
+    val value: ?loc:loc -> value_description -> signature_item
+    val type_: ?loc:loc -> type_declaration list -> signature_item
+    val exception_: ?loc:loc -> constructor_declaration -> signature_item
+    val module_: ?loc:loc -> module_declaration -> signature_item
+    val rec_module: ?loc:loc -> module_declaration list -> signature_item
+    val modtype: ?loc:loc -> module_type_declaration -> signature_item
+    val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> signature_item
+    val include_: ?loc:loc -> ?attrs:attrs -> module_type -> signature_item
+    val class_: ?loc:loc -> class_description list -> signature_item
+    val class_type: ?loc:loc -> class_type_declaration list -> signature_item
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item
+    val attribute: ?loc:loc -> attribute -> signature_item
+  end
+
+(** Structure items *)
+module Str:
+  sig
+    val mk: ?loc:loc -> structure_item_desc -> structure_item
+
+    val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item
+    val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item
+    val primitive: ?loc:loc -> value_description -> structure_item
+    val type_: ?loc:loc -> type_declaration list -> structure_item
+    val exception_: ?loc:loc -> constructor_declaration -> structure_item
+    val exn_rebind: ?loc:loc -> ?attrs:attrs -> str -> lid -> structure_item
+    val module_: ?loc:loc -> module_binding -> structure_item
+    val rec_module: ?loc:loc -> module_binding list -> structure_item
+    val modtype: ?loc:loc -> module_type_declaration -> structure_item
+    val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> structure_item
+    val class_: ?loc:loc -> class_declaration list -> structure_item
+    val class_type: ?loc:loc -> class_type_declaration list -> structure_item
+    val include_: ?loc:loc -> ?attrs:attrs -> module_expr -> structure_item
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item
+    val attribute: ?loc:loc -> attribute -> structure_item
+  end
+
+(** Module declarations *)
+module Md:
+  sig
+    val mk: ?attrs:attrs -> str -> module_type -> module_declaration
+  end
+
+(** Module type declarations *)
+module Mtd:
+  sig
+    val mk: ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration
+  end
+
+(** Module bindings *)
+module Mb:
+  sig
+    val mk: ?attrs:attrs -> str -> module_expr -> module_binding
+  end
+
+(** Value bindings *)
+
+module Vb:
+  sig
+    val mk: ?attrs:attrs -> pattern -> expression -> value_binding
+  end
+
+
+(** {2 Class language} *)
+
+(** Class type expressions *)
+module Cty:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type
+    val attr: class_type -> attribute -> class_type
+
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
+    val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type
+  end
+
+(** Class type fields *)
+module Ctf:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_type_field_desc -> class_type_field
+    val attr: class_type_field -> attribute -> class_type_field
+
+    val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field
+    val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field
+    val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field
+    val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
+  end
+
+(** Class expressions *)
+module Cl:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr
+    val attr: class_expr -> attribute -> class_expr
+
+    val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr
+    val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr
+    val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> class_expr -> class_expr
+    val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (label * expression) list -> class_expr
+    val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr
+    val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr
+  end
+
+(** Class fields *)
+module Cf:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> class_field_desc -> class_field
+    val attr: class_field -> attribute -> class_field
+
+    val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field
+    val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field
+    val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field
+    val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field
+    val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field
+    val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field
+
+    val virtual_: core_type -> class_field_kind
+    val concrete: override_flag -> expression -> class_field_kind
+  end
+
+(** Classes *)
+module Ci:
+  sig
+    val mk: ?loc:loc -> ?attrs:attrs -> ?virt:virtual_flag -> ?params:(str * variance) list -> str -> 'a -> 'a class_infos
+  end
+
+(** Class signatures *)
+module Csig:
+  sig
+    val mk: core_type -> class_type_field list -> class_signature
+  end
+
+(** Class structures *)
+module Cstr:
+  sig
+    val mk: pattern -> class_field list -> class_structure
+  end
+
+
+(** {2 Convenience functions} *)
+
+(** Convenience functions to help build and deconstruct AST fragments. *)
+module Convenience :
+  sig
+
+    (** {2 Misc} *)
+
+    val lid: string -> lid
+
+    (** {2 Expressions} *)
+
+    val evar: string -> expression
+    val let_in: ?recursive:bool -> value_binding list -> expression -> expression
+
+    val constr: string -> expression list -> expression
+    val record: ?over:expression -> (string * expression) list -> expression
+    val tuple: expression list -> expression
+
+    val nil: unit -> expression
+    val cons: expression -> expression -> expression
+    val list: expression list -> expression
+
+    val unit: unit -> expression
+
+    val func: (pattern * expression) list -> expression
+    val lam: ?label:string -> ?default:expression -> pattern -> expression -> expression
+    val app: expression -> expression list -> expression
+
+    val str: string -> expression
+    val int: int -> expression
+    val char: char -> expression
+    val float: float -> expression
+
+    (** {2 Patterns} *)
+
+    val pvar: string -> pattern
+    val pconstr: string -> pattern list -> pattern
+    val punit: unit -> pattern
+
+    (** {2 Types} *)
+
+    val tconstr: string -> core_type list -> core_type
+
+    (** {2 AST deconstruction} *)
+
+    val get_str: expression -> string option
+    val get_lid: expression -> string option
+
+    val has_attr: string -> attributes -> bool
+    val find_attr: string -> attributes -> payload option
+    val find_attr_expr: string -> attributes -> expression option
+  end
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 2caca7c67..9cd27b604 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -16,12 +16,12 @@ open Location
 open Config
 open Parsetree
 open Asttypes
+open Ast_helper
 
-(* First, some helpers to build AST fragments *)
-
-let map_flatten f l = List.flatten (List.map f l)
+let map_fst f (x, y) = (f x, y)
 let map_snd f (x, y) = (x, f y)
 let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
+let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
 let map_opt f = function None -> None | Some x -> Some (f x)
 
 let map_loc sub {loc; txt} = {loc = sub # location loc; txt}
@@ -29,416 +29,288 @@ let map_loc sub {loc; txt} = {loc = sub # location loc; txt}
 module T = struct
   (* Type expressions for the core language *)
 
-  let mk ?(loc = Location.none) x = {ptyp_desc = x; ptyp_loc = loc}
-  let any ?loc () = mk ?loc Ptyp_any
-  let var ?loc a = mk ?loc (Ptyp_var a)
-  let arrow ?loc a b c = mk ?loc (Ptyp_arrow (a, b, c))
-  let tuple ?loc a = mk ?loc (Ptyp_tuple a)
-  let constr ?loc a b = mk ?loc (Ptyp_constr (a, b))
-  let object_ ?loc a = mk ?loc (Ptyp_object a)
-  let class_ ?loc a b c = mk ?loc (Ptyp_class (a, b, c))
-  let alias ?loc a b = mk ?loc (Ptyp_alias (a, b))
-  let variant ?loc a b c = mk ?loc (Ptyp_variant (a, b, c))
-  let poly ?loc a b = mk ?loc (Ptyp_poly (a, b))
-  let package ?loc a b = mk ?loc (Ptyp_package (a, b))
-
-  let field_type ?(loc = Location.none) x = {pfield_desc = x; pfield_loc = loc}
-  let field ?loc s t =
-    let t =
-      (* The type-checker expects the field to be a Ptyp_poly. Maybe
-         it should wrap the type automatically... *)
-      match t.ptyp_desc with
-      | Ptyp_poly _ -> t
-      | _ -> poly ?loc [] t
-    in
-    field_type ?loc (Pfield (s, t))
-  let field_var ?loc () = field_type ?loc Pfield_var
-
-  let core_field_type sub {pfield_desc = desc; pfield_loc = loc} =
-    let loc = sub # location loc in
-    match desc with
-    | Pfield (s, d) -> field ~loc:(sub # location loc) s (sub # typ d)
-    | Pfield_var -> field_var ~loc ()
-
   let row_field sub = function
     | Rtag (l, b, tl) -> Rtag (l, b, List.map (sub # typ) tl)
     | Rinherit t -> Rinherit (sub # typ t)
 
-  let map sub {ptyp_desc = desc; ptyp_loc = loc} =
+  let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
+    let open Typ in
     let loc = sub # location loc in
+    let attrs = sub # attributes attrs in
     match desc with
-    | Ptyp_any -> any ~loc ()
-    | Ptyp_var s -> var ~loc s
-    | Ptyp_arrow (lab, t1, t2) -> arrow ~loc lab (sub # typ t1) (sub # typ t2)
-    | Ptyp_tuple tyl -> tuple ~loc (List.map (sub # typ) tyl)
-    | Ptyp_constr (lid, tl) -> constr ~loc (map_loc sub lid) (List.map (sub # typ) tl)
-    | Ptyp_object l -> object_ ~loc (List.map (core_field_type sub) l)
-    | Ptyp_class (lid, tl, ll) -> class_ ~loc (map_loc sub lid) (List.map (sub # typ) tl) ll
-    | Ptyp_alias (t, s) -> alias ~loc (sub # typ t) s
-    | Ptyp_variant (rl, b, ll) -> variant ~loc (List.map (row_field sub) rl) b ll
-    | Ptyp_poly (sl, t) -> poly ~loc sl (sub # typ t)
-    | Ptyp_package (lid, l) -> package ~loc (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub # typ)) l)
-
-  let map_type_declaration sub td =
-    {td with
-     ptype_cstrs =
-     List.map
-       (fun (ct1, ct2, loc) -> sub # typ ct1, sub # typ ct2, sub # location loc)
-       td.ptype_cstrs;
-     ptype_kind = sub # type_kind td.ptype_kind;
-     ptype_manifest = map_opt (sub # typ) td.ptype_manifest;
-     ptype_loc = sub # location td.ptype_loc;
-    }
+    | Ptyp_any -> any ~loc ~attrs ()
+    | Ptyp_var s -> var ~loc ~attrs s
+    | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2)
+    | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl)
+    | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl)
+    | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (map_snd (sub # typ)) l) o
+    | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl)
+    | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s
+    | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll
+    | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t)
+    | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub # typ)) l)
+    | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x)
+
+  let map_type_declaration sub
+      {ptype_name; ptype_params; ptype_cstrs;
+       ptype_kind;
+       ptype_private;
+       ptype_manifest;
+       ptype_attributes;
+       ptype_loc} =
+    Type.mk (map_loc sub ptype_name)
+      ~params:(List.map (map_fst (map_opt (map_loc sub))) ptype_params)
+      ~priv:ptype_private
+      ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) ptype_cstrs)
+      ~kind:(sub # type_kind ptype_kind)
+      ?manifest:(map_opt (sub # typ) ptype_manifest)
+      ~loc:(sub # location ptype_loc)
+      ~attrs:(sub # attributes ptype_attributes)
 
   let map_type_kind sub = function
     | Ptype_abstract -> Ptype_abstract
-    | Ptype_variant l -> Ptype_variant (List.map (fun (s, tl, t, loc) -> (map_loc sub s, List.map (sub # typ) tl, map_opt (sub # typ) t, sub # location loc)) l)
-    | Ptype_record l -> Ptype_record (List.map (fun (s, flags, t, loc) -> (map_loc sub s, flags, sub # typ t, sub # location loc)) l)
+    | Ptype_variant l -> Ptype_variant (List.map (sub # constructor_declaration) l)
+    | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l)
 end
 
 module CT = struct
   (* Type expressions for the class language *)
 
-  let mk ?(loc = Location.none) x = {pcty_loc = loc; pcty_desc = x}
-
-  let constr ?loc a b = mk ?loc (Pcty_constr (a, b))
-  let signature ?loc a = mk ?loc (Pcty_signature a)
-  let fun_ ?loc a b c = mk ?loc (Pcty_fun (a, b, c))
-
-  let map sub {pcty_loc = loc; pcty_desc = desc} =
+  let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
+    let open Cty in
     let loc = sub # location loc in
     match desc with
-    | Pcty_constr (lid, tys) -> constr ~loc (map_loc sub lid) (List.map (sub # typ) tys)
-    | Pcty_signature x -> signature ~loc (sub # class_signature x)
-    | Pcty_fun (lab, t, ct) ->
-        fun_ ~loc lab
+    | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys)
+    | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x)
+    | Pcty_arrow (lab, t, ct) ->
+        arrow ~loc ~attrs lab
           (sub # typ t)
           (sub # class_type ct)
+    | Pcty_extension x -> extension ~loc ~attrs (sub # extension x)
 
-  let mk_field ?(loc = Location.none) x = {pctf_desc = x; pctf_loc = loc}
-
-  let inher ?loc a = mk_field ?loc (Pctf_inher a)
-  let val_ ?loc a b c d = mk_field ?loc (Pctf_val (a, b, c, d))
-  let virt ?loc a b c = mk_field ?loc (Pctf_virt (a, b, c))
-  let meth ?loc a b c = mk_field ?loc (Pctf_meth (a, b, c))
-  let cstr ?loc a b = mk_field ?loc (Pctf_cstr (a, b))
-
-  let map_field sub {pctf_desc = desc; pctf_loc = loc} =
+  let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} =
+    let open Ctf in
     let loc = sub # location loc in
     match desc with
-    | Pctf_inher ct -> inher ~loc (sub # class_type ct)
-    | Pctf_val (s, m, v, t) -> val_ ~loc s m v (sub # typ t)
-    | Pctf_virt (s, p, t) -> virt ~loc s p (sub # typ t)
-    | Pctf_meth (s, p, t) -> meth ~loc s p (sub # typ t)
-    | Pctf_cstr (t1, t2) -> cstr ~loc (sub # typ t1) (sub # typ t2)
-
-  let map_signature sub {pcsig_self; pcsig_fields; pcsig_loc} =
-    {
-     pcsig_self = sub # typ pcsig_self;
-     pcsig_fields = List.map (sub # class_type_field) pcsig_fields;
-     pcsig_loc = sub # location pcsig_loc ;
-    }
+    | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct)
+    | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t)
+    | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t)
+    | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2)
+    | Pctf_extension x -> extension ~loc ~attrs (sub # extension x)
+
+  let map_signature sub {pcsig_self; pcsig_fields} =
+    Csig.mk
+      (sub # typ pcsig_self)
+      (List.map (sub # class_type_field) pcsig_fields)
 end
 
 module MT = struct
   (* Type expressions for the module language *)
 
-  let mk ?(loc = Location.none) x = {pmty_desc = x; pmty_loc = loc}
-  let ident ?loc a = mk ?loc (Pmty_ident a)
-  let signature ?loc a = mk ?loc (Pmty_signature a)
-  let functor_ ?loc a b c = mk ?loc (Pmty_functor (a, b, c))
-  let with_ ?loc a b = mk ?loc (Pmty_with (a, b))
-  let typeof_ ?loc a = mk ?loc (Pmty_typeof a)
-
-  let map sub {pmty_desc = desc; pmty_loc = loc} =
+  let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} =
+    let open Mty in
     let loc = sub # location loc in
+    let attrs = sub # attributes attrs in
     match desc with
-    | Pmty_ident s -> ident ~loc (map_loc sub s)
-    | Pmty_signature sg -> signature ~loc (sub # signature sg)
-    | Pmty_functor (s, mt1, mt2) -> functor_ ~loc (map_loc sub s) (sub # module_type mt1) (sub # module_type mt2)
-    | Pmty_with (mt, l) -> with_ ~loc (sub # module_type mt) (List.map (map_tuple (map_loc sub) (sub # with_constraint)) l)
-    | Pmty_typeof me -> typeof_ ~loc (sub # module_expr me)
+    | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
+    | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg)
+    | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (sub # module_type mt1) (sub # module_type mt2)
+    | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub # module_type mt) (List.map (sub # with_constraint) l)
+    | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me)
+    | Pmty_extension x -> extension ~loc ~attrs (sub # extension x)
 
   let map_with_constraint sub = function
-    | Pwith_type d -> Pwith_type (sub # type_declaration d)
-    | Pwith_module s -> Pwith_module (map_loc sub s)
+    | Pwith_type (lid, d) ->
+        Pwith_type (map_loc sub lid, sub # type_declaration d)
+    | Pwith_module (lid, lid2) ->
+        Pwith_module (map_loc sub lid, map_loc sub lid2)
     | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d)
-    | Pwith_modsubst s -> Pwith_modsubst (map_loc sub s)
-
-  let mk_item ?(loc = Location.none) x = {psig_desc = x; psig_loc = loc}
-
-  let value ?loc a b = mk_item ?loc (Psig_value (a, b))
-  let type_ ?loc a = mk_item ?loc (Psig_type a)
-  let exception_ ?loc a b = mk_item ?loc (Psig_exception (a, b))
-  let module_ ?loc a b = mk_item ?loc (Psig_module (a, b))
-  let rec_module ?loc a = mk_item ?loc (Psig_recmodule a)
-  let modtype ?loc a b = mk_item ?loc (Psig_modtype (a, b))
-  let open_ ?loc a b = mk_item ?loc (Psig_open (a, b))
-  let include_ ?loc a = mk_item ?loc (Psig_include a)
-  let class_ ?loc a = mk_item ?loc (Psig_class a)
-  let class_type ?loc a = mk_item ?loc (Psig_class_type a)
+    | Pwith_modsubst (s, lid) ->
+        Pwith_modsubst (map_loc sub s, map_loc sub lid)
 
   let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
+    let open Sig in
     let loc = sub # location loc in
     match desc with
-    | Psig_value (s, vd) -> value ~loc (map_loc sub s) (sub # value_description vd)
-    | Psig_type l -> type_ ~loc (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
-    | Psig_exception (s, ed) -> exception_ ~loc (map_loc sub s) (sub # exception_declaration ed)
-    | Psig_module (s, mt) -> module_ ~loc (map_loc sub s) (sub # module_type mt)
-    | Psig_recmodule l -> rec_module ~loc (List.map (map_tuple (map_loc sub) (sub # module_type)) l)
-    | Psig_modtype (s, Pmodtype_manifest mt) -> modtype ~loc (map_loc sub s) (Pmodtype_manifest  (sub # module_type mt))
-    | Psig_modtype (s, Pmodtype_abstract) -> modtype ~loc (map_loc sub s) Pmodtype_abstract
-    | Psig_open (ovf, s) -> open_ ~loc ovf (map_loc sub s)
-    | Psig_include mt -> include_ ~loc (sub # module_type mt)
+    | Psig_value vd -> value ~loc (sub # value_description vd)
+    | Psig_type l -> type_ ~loc (List.map (sub # type_declaration) l)
+    | Psig_exception ed -> exception_ ~loc (sub # constructor_declaration ed)
+    | Psig_module x -> module_ ~loc (sub # module_declaration x)
+    | Psig_recmodule l -> rec_module ~loc (List.map (sub # module_declaration) l)
+    | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x)
+    | Psig_open (ovf, lid, attrs) -> open_ ~loc ~attrs:(sub # attributes attrs) ovf (map_loc sub lid)
+    | Psig_include (mt, attrs) -> include_ ~loc (sub # module_type mt) ~attrs:(sub # attributes attrs)
     | Psig_class l -> class_ ~loc (List.map (sub # class_description) l)
     | Psig_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l)
-
+    | Psig_extension (x, attrs) -> extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs)
+    | Psig_attribute x -> attribute ~loc (sub # attribute x)
 end
 
 
 module M = struct
   (* Value expressions for the module language *)
 
-  let mk ?(loc = Location.none) x = {pmod_desc = x; pmod_loc = loc}
-  let ident ?loc x = mk ?loc (Pmod_ident x)
-  let structure ?loc x = mk ?loc (Pmod_structure x)
-  let functor_ ?loc arg arg_ty body = mk ?loc (Pmod_functor (arg, arg_ty, body))
-  let apply ?loc m1 m2 = mk ?loc (Pmod_apply (m1, m2))
-  let constraint_ ?loc m mty = mk ?loc (Pmod_constraint (m, mty))
-  let unpack ?loc e = mk ?loc (Pmod_unpack e)
-
-  let map sub {pmod_loc = loc; pmod_desc = desc} =
+  let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+    let open Mod in
     let loc = sub # location loc in
+    let attrs = sub # attributes attrs in
     match desc with
-    | Pmod_ident x -> ident ~loc (map_loc sub x)
-    | Pmod_structure str -> structure ~loc (sub # structure str)
-    | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc (map_loc sub arg) (sub # module_type arg_ty) (sub # module_expr body)
-    | Pmod_apply (m1, m2) -> apply ~loc (sub # module_expr m1) (sub # module_expr m2)
-    | Pmod_constraint (m, mty) -> constraint_ ~loc (sub # module_expr m) (sub # module_type mty)
-    | Pmod_unpack e -> unpack ~loc (sub # expr e)
-
-  let mk_item ?(loc = Location.none) x = {pstr_desc = x; pstr_loc = loc}
-  let eval ?loc a = mk_item ?loc (Pstr_eval a)
-  let value ?loc a b = mk_item ?loc (Pstr_value (a, b))
-  let primitive ?loc a b = mk_item ?loc (Pstr_primitive (a, b))
-  let type_ ?loc a = mk_item ?loc (Pstr_type a)
-  let exception_ ?loc a b = mk_item ?loc (Pstr_exception (a, b))
-  let exn_rebind ?loc a b = mk_item ?loc (Pstr_exn_rebind (a, b))
-  let module_ ?loc a b = mk_item ?loc (Pstr_module (a, b))
-  let rec_module ?loc a = mk_item ?loc (Pstr_recmodule a)
-  let modtype ?loc a b = mk_item ?loc (Pstr_modtype (a, b))
-  let open_ ?loc a b = mk_item ?loc (Pstr_open (a, b))
-  let class_ ?loc a = mk_item ?loc (Pstr_class a)
-  let class_type ?loc a = mk_item ?loc (Pstr_class_type a)
-  let include_ ?loc a = mk_item ?loc (Pstr_include a)
+    | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pmod_structure str -> structure ~loc ~attrs (sub # structure str)
+    | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (sub # module_type arg_ty) (sub # module_expr body)
+    | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2)
+    | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty)
+    | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e)
+    | Pmod_extension x -> extension ~loc ~attrs (sub # extension x)
 
   let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
+    let open Str in
     let loc = sub # location loc in
     match desc with
-    | Pstr_eval x -> eval ~loc (sub # expr x)
-    | Pstr_value (r, pel) -> value ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel)
-    | Pstr_primitive (name, vd) -> primitive ~loc (map_loc sub name) (sub # value_description vd)
-    | Pstr_type l -> type_ ~loc (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
-    | Pstr_exception (name, ed) -> exception_ ~loc (map_loc sub name) (sub # exception_declaration ed)
-    | Pstr_exn_rebind (s, lid) -> exn_rebind ~loc (map_loc sub s) (map_loc sub lid)
-    | Pstr_module (s, m) -> module_ ~loc (map_loc sub s) (sub # module_expr m)
-    | Pstr_recmodule l -> rec_module ~loc (List.map (fun (s, mty, me) -> (map_loc sub s, sub # module_type mty, sub # module_expr me)) l)
-    | Pstr_modtype (s, mty) -> modtype ~loc (map_loc sub s) (sub # module_type mty)
-    | Pstr_open (ovf, lid) -> open_ ~loc ovf (map_loc sub lid)
+    | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x)
+    | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs)
+    | Pstr_primitive vd -> primitive ~loc (sub # value_description vd)
+    | Pstr_type l -> type_ ~loc (List.map (sub # type_declaration) l)
+    | Pstr_exception ed -> exception_ ~loc (sub # constructor_declaration ed)
+    | Pstr_exn_rebind (s, lid, attrs) -> exn_rebind ~loc (map_loc sub s) (map_loc sub lid) ~attrs:(sub # attributes attrs)
+    | Pstr_module x -> module_ ~loc (sub # module_binding x)
+    | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l)
+    | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x)
+    | Pstr_open (ovf, lid, attrs) -> open_ ~loc ~attrs:(sub # attributes attrs) ovf (map_loc sub lid)
     | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l)
     | Pstr_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l)
-    | Pstr_include e -> include_ ~loc (sub # module_expr e)
+    | Pstr_include (e, attrs) -> include_ ~loc (sub # module_expr e) ~attrs:(sub # attributes attrs)
+    | Pstr_extension (x, attrs) -> extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs)
+    | Pstr_attribute x -> attribute ~loc (sub # attribute x)
 end
 
 module E = struct
   (* Value expressions for the core language *)
 
-  let mk ?(loc = Location.none) x = {pexp_desc = x; pexp_loc = loc}
-
-  let ident ?loc a = mk ?loc (Pexp_ident a)
-  let constant ?loc a = mk ?loc (Pexp_constant a)
-  let let_ ?loc a b c = mk ?loc (Pexp_let (a, b, c))
-  let function_ ?loc a b c = mk ?loc (Pexp_function (a, b, c))
-  let apply ?loc a b = mk ?loc (Pexp_apply (a, b))
-  let match_ ?loc a b = mk ?loc (Pexp_match (a, b))
-  let try_ ?loc a b = mk ?loc (Pexp_try (a, b))
-  let tuple ?loc a = mk ?loc (Pexp_tuple a)
-  let construct ?loc a b c = mk ?loc (Pexp_construct (a, b, c))
-  let variant ?loc a b = mk ?loc (Pexp_variant (a, b))
-  let record ?loc a b = mk ?loc (Pexp_record (a, b))
-  let field ?loc a b = mk ?loc (Pexp_field (a, b))
-  let setfield ?loc a b c = mk ?loc (Pexp_setfield (a, b, c))
-  let array ?loc a = mk ?loc (Pexp_array a)
-  let ifthenelse ?loc a b c = mk ?loc (Pexp_ifthenelse (a, b, c))
-  let sequence ?loc a b = mk ?loc (Pexp_sequence (a, b))
-  let while_ ?loc a b = mk ?loc (Pexp_while (a, b))
-  let for_ ?loc a b c d e = mk ?loc (Pexp_for (a, b, c, d, e))
-  let constraint_ ?loc a b c = mk ?loc (Pexp_constraint (a, b, c))
-  let when_ ?loc a b = mk ?loc (Pexp_when (a, b))
-  let send ?loc a b = mk ?loc (Pexp_send (a, b))
-  let new_ ?loc a = mk ?loc (Pexp_new a)
-  let setinstvar ?loc a b = mk ?loc (Pexp_setinstvar (a, b))
-  let override ?loc a = mk ?loc (Pexp_override a)
-  let letmodule ?loc (a, b, c)= mk ?loc (Pexp_letmodule (a, b, c))
-  let assert_ ?loc a = mk ?loc (Pexp_assert a)
-  let assertfalse ?loc () = mk ?loc Pexp_assertfalse
-  let lazy_ ?loc a = mk ?loc (Pexp_lazy a)
-  let poly ?loc a b = mk ?loc (Pexp_poly (a, b))
-  let object_ ?loc a = mk ?loc (Pexp_object a)
-  let newtype ?loc a b = mk ?loc (Pexp_newtype (a, b))
-  let pack ?loc a = mk ?loc (Pexp_pack a)
-  let open_ ?loc a b c = mk ?loc (Pexp_open (a, b, c))
-
-  let lid ?(loc = Location.none) lid = ident ~loc (mkloc (Longident.parse lid) loc)
-  let apply_nolabs ?loc f el = apply ?loc f (List.map (fun e -> ("", e)) el)
-  let strconst ?loc x = constant ?loc (Const_string x)
-
-  let map sub {pexp_loc = loc; pexp_desc = desc} =
+  let lid ?(loc = Location.none) ?attrs lid = Exp.ident ~loc ?attrs (mkloc (Longident.parse lid) loc)
+  let apply_nolabs ?loc ?attrs f el = Exp.apply ?loc ?attrs f (List.map (fun e -> ("", e)) el)
+  let strconst ?loc ?attrs x = Exp.constant ?loc ?attrs (Const_string (x, None))
+
+  let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
+    let open Exp in
     let loc = sub # location loc in
+    let attrs = sub # attributes attrs in
     match desc with
-    | Pexp_ident x -> ident ~loc (map_loc sub x)
-    | Pexp_constant x -> constant ~loc x
-    | Pexp_let (r, pel, e) -> let_ ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel) (sub # expr e)
-    | Pexp_function (lab, def, pel) -> function_ ~loc lab (map_opt (sub # expr) def) (List.map (map_tuple (sub # pat) (sub # expr)) pel)
-    | Pexp_apply (e, l) -> apply ~loc (sub # expr e) (List.map (map_snd (sub # expr)) l)
-    | Pexp_match (e, l) -> match_ ~loc (sub # expr e) (List.map (map_tuple (sub # pat) (sub # expr)) l)
-    | Pexp_try (e, l) -> try_ ~loc (sub # expr e) (List.map (map_tuple (sub # pat) (sub # expr)) l)
-    | Pexp_tuple el -> tuple ~loc (List.map (sub # expr) el)
-    | Pexp_construct (lid, arg, b) -> construct ~loc (map_loc sub lid) (map_opt (sub # expr) arg) b
-    | Pexp_variant (lab, eo) -> variant ~loc lab (map_opt (sub # expr) eo)
-    | Pexp_record (l, eo) -> record ~loc (List.map (map_tuple (map_loc sub) (sub # expr)) l) (map_opt (sub # expr) eo)
-    | Pexp_field (e, lid) -> field ~loc (sub # expr e) (map_loc sub lid)
-    | Pexp_setfield (e1, lid, e2) -> setfield ~loc (sub # expr e1) (map_loc sub lid) (sub # expr e2)
-    | Pexp_array el -> array ~loc (List.map (sub # expr) el)
-    | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc (sub # expr e1) (sub # expr e2) (map_opt (sub # expr) e3)
-    | Pexp_sequence (e1, e2) -> sequence ~loc (sub # expr e1) (sub # expr e2)
-    | Pexp_while (e1, e2) -> while_ ~loc (sub # expr e1) (sub # expr e2)
-    | Pexp_for (id, e1, e2, d, e3) -> for_ ~loc (map_loc sub id) (sub # expr e1) (sub # expr e2) d (sub # expr e3)
-    | Pexp_constraint (e, t1, t2) -> constraint_ ~loc (sub # expr e) (map_opt (sub # typ) t1) (map_opt (sub # typ) t2)
-    | Pexp_when (e1, e2) -> when_ ~loc (sub # expr e1) (sub # expr e2)
-    | Pexp_send (e, s) -> send ~loc (sub # expr e) s
-    | Pexp_new lid -> new_ ~loc (map_loc sub lid)
-    | Pexp_setinstvar (s, e) -> setinstvar ~loc (map_loc sub s) (sub # expr e)
-    | Pexp_override sel -> override ~loc (List.map (map_tuple (map_loc sub) (sub # expr)) sel)
-    | Pexp_letmodule (s, me, e) -> letmodule ~loc (map_loc sub s, sub # module_expr me, sub # expr e)
-    | Pexp_assert e -> assert_ ~loc (sub # expr e)
-    | Pexp_assertfalse -> assertfalse ~loc ()
-    | Pexp_lazy e -> lazy_ ~loc (sub # expr e)
-    | Pexp_poly (e, t) -> poly ~loc (sub # expr e) (map_opt (sub # typ) t)
-    | Pexp_object cls -> object_ ~loc (sub # class_structure cls)
-    | Pexp_newtype (s, e) -> newtype ~loc s (sub # expr e)
-    | Pexp_pack me -> pack ~loc (sub # module_expr me)
-    | Pexp_open (ovf, lid, e) -> open_ ~loc ovf (map_loc sub lid) (sub # expr e)
+    | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pexp_constant x -> constant ~loc ~attrs x
+    | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e)
+    | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) (sub # expr e)
+    | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel)
+    | Pexp_apply (e, l) -> apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l)
+    | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel)
+    | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel)
+    | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el)
+    | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg)
+    | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub # expr) eo)
+    | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) (map_opt (sub # expr) eo)
+    | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid)
+    | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2)
+    | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el)
+    | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) (map_opt (sub # expr) e3)
+    | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub # expr e1) (sub # expr e2)
+    | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2)
+    | Pexp_for (id, e1, e2, d, e3) -> for_ ~loc ~attrs (map_loc sub id) (sub # expr e1) (sub # expr e2) d (sub # expr e3)
+    | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) (sub # typ t2)
+    | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub # expr e) (sub # typ t)
+    | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s
+    | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid)
+    | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e)
+    | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) sel)
+    | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) (sub # expr e)
+    | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e)
+    | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e)
+    | Pexp_poly (e, t) -> poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t)
+    | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls)
+    | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e)
+    | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me)
+    | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e)
+    | Pexp_extension x -> extension ~loc ~attrs (sub # extension x)
 end
 
 module P = struct
   (* Patterns *)
 
-  let mk ?(loc = Location.none) x = {ppat_desc = x; ppat_loc = loc}
-  let any ?loc () = mk ?loc Ppat_any
-  let var ?loc a = mk ?loc (Ppat_var a)
-  let alias ?loc a b = mk ?loc (Ppat_alias (a, b))
-  let constant ?loc a = mk ?loc (Ppat_constant a)
-  let tuple ?loc a = mk ?loc (Ppat_tuple a)
-  let construct ?loc a b c = mk ?loc (Ppat_construct (a, b, c))
-  let variant ?loc a b = mk ?loc (Ppat_variant (a, b))
-  let record ?loc a b = mk ?loc (Ppat_record (a, b))
-  let array ?loc a = mk ?loc (Ppat_array a)
-  let or_ ?loc a b = mk ?loc (Ppat_or (a, b))
-  let constraint_ ?loc a b = mk ?loc (Ppat_constraint (a, b))
-  let type_ ?loc a = mk ?loc (Ppat_type a)
-  let lazy_ ?loc a = mk ?loc (Ppat_lazy a)
-  let unpack ?loc a = mk ?loc (Ppat_unpack a)
-
-  let map sub {ppat_desc = desc; ppat_loc = loc} =
+  let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} =
+    let open Pat in
     let loc = sub # location loc in
+    let attrs = sub # attributes attrs in
     match desc with
-    | Ppat_any -> any ~loc ()
-    | Ppat_var s -> var ~loc (map_loc sub s)
-    | Ppat_alias (p, s) -> alias ~loc (sub # pat p) (map_loc sub s)
-    | Ppat_constant c -> constant ~loc c
-    | Ppat_tuple pl -> tuple ~loc (List.map (sub # pat) pl)
-    | Ppat_construct (l, p, b) -> construct ~loc (map_loc sub l) (map_opt (sub # pat) p) b
-    | Ppat_variant (l, p) -> variant ~loc l (map_opt (sub # pat) p)
+    | Ppat_any -> any ~loc ~attrs ()
+    | Ppat_var s -> var ~loc ~attrs (map_loc sub s)
+    | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s)
+    | Ppat_constant c -> constant ~loc ~attrs c
+    | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
+    | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl)
+    | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p)
+    | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p)
     | Ppat_record (lpl, cf) ->
-        record ~loc (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) cf
-    | Ppat_array pl -> array ~loc (List.map (sub # pat) pl)
-    | Ppat_or (p1, p2) -> or_ ~loc (sub # pat p1) (sub # pat p2)
-    | Ppat_constraint (p, t) -> constraint_ ~loc (sub # pat p) (sub # typ t)
-    | Ppat_type s -> type_ ~loc (map_loc sub s)
-    | Ppat_lazy p -> lazy_ ~loc (sub # pat p)
-    | Ppat_unpack s -> unpack ~loc (map_loc sub s)
+        record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) cf
+    | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl)
+    | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2)
+    | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub # pat p) (sub # typ t)
+    | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s)
+    | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p)
+    | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
+    | Ppat_extension x -> extension ~loc ~attrs (sub # extension x)
 end
 
 module CE = struct
   (* Value expressions for the class language *)
 
-  let mk ?(loc = Location.none) x = {pcl_loc = loc; pcl_desc = x}
-
-  let constr ?loc a b = mk ?loc (Pcl_constr (a, b))
-  let structure ?loc a = mk ?loc (Pcl_structure a)
-  let fun_ ?loc a b c d = mk ?loc (Pcl_fun (a, b, c, d))
-  let apply ?loc a b = mk ?loc (Pcl_apply (a, b))
-  let let_ ?loc a b c = mk ?loc (Pcl_let (a, b, c))
-  let constraint_ ?loc a b = mk ?loc (Pcl_constraint (a, b))
-
-  let map sub {pcl_loc = loc; pcl_desc = desc} =
+  let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
+    let open Cl in
     let loc = sub # location loc in
     match desc with
-    | Pcl_constr (lid, tys) -> constr ~loc (map_loc sub lid) (List.map (sub # typ) tys)
+    | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys)
     | Pcl_structure s ->
-        structure ~loc (sub # class_structure s)
+        structure ~loc ~attrs (sub # class_structure s)
     | Pcl_fun (lab, e, p, ce) ->
-        fun_ ~loc lab
+        fun_ ~loc ~attrs lab
           (map_opt (sub # expr) e)
           (sub # pat p)
           (sub # class_expr ce)
     | Pcl_apply (ce, l) ->
-        apply ~loc (sub # class_expr ce) (List.map (map_snd (sub # expr)) l)
-    | Pcl_let (r, pel, ce) ->
-        let_ ~loc r
-          (List.map (map_tuple (sub # pat) (sub # expr)) pel)
-          (sub # class_expr ce)
+        apply ~loc ~attrs (sub # class_expr ce) (List.map (map_snd (sub # expr)) l)
+    | Pcl_let (r, vbs, ce) ->
+      let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # class_expr ce)
     | Pcl_constraint (ce, ct) ->
-        constraint_ ~loc (sub # class_expr ce) (sub # class_type ct)
-
+        constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct)
+    | Pcl_extension x -> extension ~loc ~attrs (sub # extension x)
 
-  let mk_field ?(loc = Location.none) x = {pcf_desc = x; pcf_loc = loc}
+  let map_kind sub = function
+    | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e)
+    | Cfk_virtual t -> Cfk_virtual (sub # typ t)
 
-  let inher ?loc a b c = mk_field ?loc (Pcf_inher (a, b, c))
-  let valvirt ?loc a b c = mk_field ?loc (Pcf_valvirt (a, b, c))
-  let val_ ?loc a b c d = mk_field ?loc (Pcf_val (a, b, c, d))
-  let virt ?loc a b c = mk_field ?loc (Pcf_virt (a, b, c))
-  let meth ?loc a b c d = mk_field ?loc (Pcf_meth (a, b, c, d))
-  let constr ?loc a b = mk_field ?loc (Pcf_constr (a, b))
-  let init ?loc a = mk_field ?loc (Pcf_init a)
-
-  let map_field sub {pcf_desc = desc; pcf_loc = loc} =
+  let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
+    let open Cf in
     let loc = sub # location loc in
     match desc with
-    | Pcf_inher (o, ce, s) -> inher ~loc o (sub # class_expr ce) s
-    | Pcf_valvirt (s, m, t) -> valvirt ~loc (map_loc sub s) m (sub # typ t)
-    | Pcf_val (s, m, o, e) -> val_ ~loc (map_loc sub s) m o (sub # expr e)
-    | Pcf_virt (s, p, t) -> virt ~loc (map_loc sub s) p (sub # typ t)
-    | Pcf_meth (s, p, o, e) -> meth ~loc (map_loc sub s) p o (sub # expr e)
-    | Pcf_constr (t1, t2) -> constr ~loc (sub # typ t1) (sub # typ t2)
-    | Pcf_init e -> init ~loc (sub # expr e)
-
-  let map_structure sub {pcstr_pat; pcstr_fields} =
+    | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s
+    | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k)
+    | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k)
+    | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2)
+    | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e)
+    | Pcf_extension x -> extension ~loc ~attrs (sub # extension x)
+
+  let map_structure sub {pcstr_self; pcstr_fields} =
     {
-     pcstr_pat = sub # pat pcstr_pat;
+     pcstr_self = sub # pat pcstr_self;
      pcstr_fields = List.map (sub # class_field) pcstr_fields;
     }
 
-  let class_infos sub f {pci_virt; pci_params = (pl, ploc); pci_name; pci_expr; pci_variance; pci_loc} =
-    {
-     pci_virt;
-     pci_params = List.map (map_loc sub) pl, sub # location ploc;
-     pci_name = map_loc sub pci_name;
-     pci_expr = f pci_expr;
-     pci_variance;
-     pci_loc = sub # location pci_loc;
-    }
+  let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} =
+    Ci.mk
+     ~virt:pci_virt
+     ~params:(List.map (map_fst (map_loc sub)) pl)
+      (map_loc sub pci_name)
+      (f pci_expr)
+      ~loc:(sub # location pci_loc)
+      ~attrs:(sub # attributes pci_attributes)
 end
 
 (* Now, a generic AST mapper class, to be extended to cover all kinds
@@ -449,12 +321,12 @@ class mapper =
   object(this)
     method implementation (input_name : string) ast = (input_name, this # structure ast)
     method interface (input_name: string) ast = (input_name, this # signature ast)
-    method structure l = map_flatten (this # structure_item) l
-    method structure_item si = [ M.map_structure_item this si ]
+    method structure l = List.map (this # structure_item) l
+    method structure_item si = M.map_structure_item this si
     method module_expr = M.map this
 
-    method signature l = map_flatten (this # signature_item) l
-    method signature_item si = [ MT.map_signature_item this si ]
+    method signature l = List.map (this # signature_item) l
+    method signature_item si = MT.map_signature_item this si
     method module_type = MT.map this
     method with_constraint c = MT.map_with_constraint this c
 
@@ -474,18 +346,76 @@ class mapper =
     method type_kind = T.map_type_kind this
     method typ = T.map this
 
-    method value_description {pval_type; pval_prim; pval_loc} =
-      {
-       pval_type = this # typ pval_type;
-       pval_prim;
-       pval_loc = this # location pval_loc;
-      }
+    method value_description {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} =
+      Val.mk
+        (map_loc this pval_name)
+        (this # typ pval_type)
+        ~attrs:(this # attributes pval_attributes)
+        ~loc:(this # location pval_loc)
+        ~prim:pval_prim
+
     method pat = P.map this
     method expr = E.map this
 
-    method exception_declaration tl = List.map (this # typ) tl
+    method module_declaration {pmd_name; pmd_type; pmd_attributes} =
+      Md.mk
+        (map_loc this pmd_name)
+        (this # module_type pmd_type)
+        ~attrs:(this # attributes pmd_attributes)
+
+    method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes} =
+      {
+       pmtd_name = map_loc this pmtd_name;
+       pmtd_type = map_opt (this # module_type) pmtd_type;
+       pmtd_attributes = this # attributes pmtd_attributes;
+      }
+
+    method module_binding {pmb_name; pmb_expr; pmb_attributes} =
+      Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr)
+        ~attrs:(this # attributes pmb_attributes)
+
+    method value_binding {pvb_pat; pvb_expr; pvb_attributes} =
+      Vb.mk
+        (this # pat pvb_pat)
+        (this # expr pvb_expr)
+        ~attrs:(this # attributes pvb_attributes)
+
+
+    method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
+      Type.constructor
+        (map_loc this pcd_name)
+        ~args:(List.map (this # typ) pcd_args)
+        ?res:(map_opt (this # typ) pcd_res)
+        ~loc:(this # location pcd_loc)
+        ~attrs:(this # attributes pcd_attributes)
+
+    method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} =
+      Type.field
+        (map_loc this pld_name)
+        (this # typ pld_type)
+        ~mut:pld_mutable
+        ~loc:(this # location pld_loc)
+        ~attrs:(this # attributes pld_attributes)
+
+    method cases l = List.map (this # case) l
+    method case {pc_lhs; pc_guard; pc_rhs} =
+      {
+       pc_lhs = this # pat pc_lhs;
+       pc_guard = map_opt (this # expr) pc_guard;
+       pc_rhs = this # expr pc_rhs;
+    }
+
+
 
     method location l = l
+
+    method extension (s, e) = (map_loc this s, this # payload e)
+    method attribute (s, e) = (map_loc this s, this # payload e)
+    method attributes l = List.map (this # attribute) l
+    method payload = function
+      | PStr x -> PStr (this # structure x)
+      | PTyp x -> PTyp (this # typ x)
+      | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g)
   end
 
 class type main_entry_points =
diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli
index 10be4a8eb..b5ad431a6 100644
--- a/parsing/ast_mapper.mli
+++ b/parsing/ast_mapper.mli
@@ -12,13 +12,14 @@
 
 (** Helpers to write Parsetree rewriters *)
 
-open Asttypes
 open Parsetree
 
 (** {2 A generic mapper class} *)
 
 class mapper:
   object
+    method case: case -> case
+    method cases: case list -> case list
     method class_declaration: class_declaration -> class_declaration
     method class_description: class_description -> class_description
     method class_expr: class_expr -> class_expr
@@ -28,23 +29,32 @@ class mapper:
     method class_type: class_type -> class_type
     method class_type_declaration: class_type_declaration -> class_type_declaration
     method class_type_field: class_type_field -> class_type_field
-    method exception_declaration: exception_declaration -> exception_declaration
     method expr: expression -> expression
     method implementation: string -> structure -> string * structure
     method interface: string -> signature -> string * signature
     method location: Location.t -> Location.t
+    method module_binding: module_binding -> module_binding
+    method module_declaration: module_declaration -> module_declaration
     method module_expr: module_expr -> module_expr
     method module_type: module_type -> module_type
+    method module_type_declaration: module_type_declaration -> module_type_declaration
     method pat: pattern -> pattern
     method signature: signature -> signature
-    method signature_item: signature_item -> signature_item list
+    method signature_item: signature_item -> signature_item
     method structure: structure -> structure
-    method structure_item: structure_item -> structure_item list
+    method structure_item: structure_item -> structure_item
     method typ: core_type -> core_type
     method type_declaration: type_declaration -> type_declaration
     method type_kind: type_kind -> type_kind
     method value_description: value_description -> value_description
     method with_constraint: with_constraint -> with_constraint
+    method attribute: attribute -> attribute
+    method attributes: attribute list -> attribute list
+    method extension: extension -> extension
+    method constructor_declaration: constructor_declaration -> constructor_declaration
+    method label_declaration: label_declaration -> label_declaration
+    method value_binding: value_binding -> value_binding
+    method payload: payload -> payload
   end
 
 class type main_entry_points =
@@ -83,182 +93,3 @@ val register: string -> (string list -> #mapper) -> unit
         themselves, and then run all or some of them.  It is also
         possible to have -ppx drivers apply rewriters to only specific
         parts of an AST.  *)
-
-
-(** {2 Helpers to build Parsetree fragments} *)
-
-module T:
-  sig
-    val mk: ?loc:Location.t -> core_type_desc -> core_type
-    val any: ?loc:Location.t -> unit -> core_type
-    val var: ?loc:Location.t -> string -> core_type
-    val arrow: ?loc:Location.t -> label -> core_type -> core_type -> core_type
-    val tuple: ?loc:Location.t -> core_type list -> core_type
-    val constr: ?loc:Location.t -> Longident.t loc -> core_type list -> core_type
-    val object_: ?loc:Location.t -> core_field_type list -> core_type
-    val class_: ?loc:Location.t -> Longident.t loc -> core_type list -> label list -> core_type
-    val alias: ?loc:Location.t -> core_type -> string -> core_type
-    val variant: ?loc:Location.t -> row_field list -> bool -> label list option -> core_type
-    val poly: ?loc:Location.t -> string list -> core_type -> core_type
-    val package: ?loc:Location.t -> Longident.t loc -> (Longident.t loc * core_type) list -> core_type
-    val field_type: ?loc:Location.t -> core_field_desc -> core_field_type
-    val field: ?loc:Location.t -> string -> core_type -> core_field_type
-    val field_var: ?loc:Location.t -> unit -> core_field_type
-    val core_field_type: mapper -> core_field_type -> core_field_type
-    val row_field: mapper -> row_field -> row_field
-    val map: mapper -> core_type -> core_type
-    val map_type_declaration: mapper -> type_declaration -> type_declaration
-    val map_type_kind: mapper -> type_kind -> type_kind
-  end
-
-module CT:
-  sig
-    val mk: ?loc:Location.t -> class_type_desc -> class_type
-    val constr: ?loc:Location.t -> Longident.t loc -> core_type list -> class_type
-    val signature: ?loc:Location.t -> class_signature -> class_type
-    val fun_: ?loc:Location.t -> label -> core_type -> class_type -> class_type
-    val map: mapper -> class_type -> class_type
-    val mk_field: ?loc:Location.t -> class_type_field_desc -> class_type_field
-    val inher: ?loc:Location.t -> class_type -> class_type_field
-    val val_: ?loc:Location.t -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field
-    val virt: ?loc:Location.t -> string -> private_flag -> core_type -> class_type_field
-    val meth: ?loc:Location.t -> string -> private_flag -> core_type -> class_type_field
-    val cstr: ?loc:Location.t -> core_type -> core_type -> class_type_field
-    val map_field: mapper -> class_type_field -> class_type_field
-    val map_signature: mapper -> class_signature -> class_signature
-  end
-
-module MT:
-  sig
-    val mk: ?loc:Location.t -> module_type_desc -> module_type
-    val ident: ?loc:Location.t -> Longident.t loc -> module_type
-    val signature: ?loc:Location.t -> signature -> module_type
-    val functor_: ?loc:Location.t -> string loc -> module_type -> module_type -> module_type
-    val with_: ?loc:Location.t -> module_type -> (Longident.t loc * with_constraint) list -> module_type
-    val typeof_: ?loc:Location.t -> module_expr -> module_type
-    val map: mapper -> module_type -> module_type
-    val map_with_constraint: mapper -> with_constraint -> with_constraint
-    val mk_item: ?loc:Location.t -> signature_item_desc -> signature_item
-    val value: ?loc:Location.t -> string loc -> value_description -> signature_item
-    val type_: ?loc:Location.t -> (string loc * type_declaration) list -> signature_item
-    val exception_: ?loc:Location.t -> string loc -> exception_declaration -> signature_item
-    val module_: ?loc:Location.t -> string loc -> module_type -> signature_item
-    val rec_module: ?loc:Location.t -> (string loc * module_type) list -> signature_item
-    val modtype: ?loc:Location.t -> string loc -> modtype_declaration -> signature_item
-    val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> signature_item
-    val include_: ?loc:Location.t -> module_type -> signature_item
-    val class_: ?loc:Location.t -> class_description list -> signature_item
-    val class_type: ?loc:Location.t -> class_type_declaration list -> signature_item
-    val map_signature_item: mapper -> signature_item -> signature_item
-  end
-
-module M:
-  sig
-    val mk: ?loc:Location.t -> module_expr_desc -> module_expr
-    val ident: ?loc:Location.t -> Longident.t loc -> module_expr
-    val structure: ?loc:Location.t -> structure -> module_expr
-    val functor_: ?loc:Location.t -> string loc -> module_type -> module_expr -> module_expr
-    val apply: ?loc:Location.t -> module_expr -> module_expr -> module_expr
-    val constraint_: ?loc:Location.t -> module_expr -> module_type -> module_expr
-    val unpack: ?loc:Location.t -> expression -> module_expr
-    val map: mapper -> module_expr -> module_expr
-    val mk_item: ?loc:Location.t -> structure_item_desc -> structure_item
-    val eval: ?loc:Location.t -> expression -> structure_item
-    val value: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> structure_item
-    val primitive: ?loc:Location.t -> string loc -> value_description -> structure_item
-    val type_: ?loc:Location.t -> (string loc * type_declaration) list -> structure_item
-    val exception_: ?loc:Location.t -> string loc -> exception_declaration -> structure_item
-    val exn_rebind: ?loc:Location.t -> string loc -> Longident.t loc -> structure_item
-    val module_: ?loc:Location.t -> string loc -> module_expr -> structure_item
-    val rec_module: ?loc:Location.t -> (string loc * module_type * module_expr)      list -> structure_item
-    val modtype: ?loc:Location.t -> string loc -> module_type -> structure_item
-    val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> structure_item
-    val class_: ?loc:Location.t -> class_declaration list -> structure_item
-    val class_type: ?loc:Location.t -> class_type_declaration list -> structure_item
-    val include_: ?loc:Location.t -> module_expr -> structure_item
-    val map_structure_item: mapper -> structure_item -> structure_item
-  end
-
-module E:
-  sig
-    val mk: ?loc:Location.t -> expression_desc -> expression
-    val ident: ?loc:Location.t -> Longident.t loc -> expression
-    val constant: ?loc:Location.t -> constant -> expression
-    val let_: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> expression -> expression
-    val function_: ?loc:Location.t -> label -> expression option -> (pattern * expression) list -> expression
-    val apply: ?loc:Location.t -> expression -> (label * expression) list -> expression
-    val match_: ?loc:Location.t -> expression -> (pattern * expression) list -> expression
-    val try_: ?loc:Location.t -> expression -> (pattern * expression) list -> expression
-    val tuple: ?loc:Location.t -> expression list -> expression
-    val construct: ?loc:Location.t -> Longident.t loc -> expression option -> bool -> expression
-    val variant: ?loc:Location.t -> label -> expression option -> expression
-    val record: ?loc:Location.t -> (Longident.t loc * expression) list -> expression option -> expression
-    val field: ?loc:Location.t -> expression -> Longident.t loc -> expression
-    val setfield: ?loc:Location.t -> expression -> Longident.t loc -> expression -> expression
-    val array: ?loc:Location.t -> expression list -> expression
-    val ifthenelse: ?loc:Location.t -> expression -> expression -> expression option -> expression
-    val sequence: ?loc:Location.t -> expression -> expression -> expression
-    val while_: ?loc:Location.t -> expression -> expression -> expression
-    val for_: ?loc:Location.t -> string loc -> expression -> expression -> direction_flag -> expression -> expression
-    val constraint_: ?loc:Location.t -> expression -> core_type option -> core_type option -> expression
-    val when_: ?loc:Location.t -> expression -> expression -> expression
-    val send: ?loc:Location.t -> expression -> string -> expression
-    val new_: ?loc:Location.t -> Longident.t loc -> expression
-    val setinstvar: ?loc:Location.t -> string loc -> expression -> expression
-    val override: ?loc:Location.t -> (string loc * expression) list -> expression
-    val letmodule: ?loc:Location.t -> string loc * module_expr * expression -> expression
-    val assert_: ?loc:Location.t -> expression -> expression
-    val assertfalse: ?loc:Location.t -> unit -> expression
-    val lazy_: ?loc:Location.t -> expression -> expression
-    val poly: ?loc:Location.t -> expression -> core_type option -> expression
-    val object_: ?loc:Location.t -> class_structure -> expression
-    val newtype: ?loc:Location.t -> string -> expression -> expression
-    val pack: ?loc:Location.t -> module_expr -> expression
-    val open_: ?loc:Location.t -> override_flag -> Longident.t loc -> expression -> expression
-    val lid: ?loc:Location.t -> string -> expression
-    val apply_nolabs: ?loc:Location.t -> expression -> expression list -> expression
-    val strconst: ?loc:Location.t -> string -> expression
-    val map: mapper -> expression -> expression
-  end
-
-module P:
-  sig
-    val mk: ?loc:Location.t -> pattern_desc -> pattern
-    val any: ?loc:Location.t -> unit -> pattern
-    val var: ?loc:Location.t -> string loc -> pattern
-    val alias: ?loc:Location.t -> pattern -> string loc -> pattern
-    val constant: ?loc:Location.t -> constant -> pattern
-    val tuple: ?loc:Location.t -> pattern list -> pattern
-    val construct: ?loc:Location.t -> Longident.t loc -> pattern option -> bool -> pattern
-    val variant: ?loc:Location.t -> label -> pattern option -> pattern
-    val record: ?loc:Location.t -> (Longident.t loc * pattern) list -> closed_flag -> pattern
-    val array: ?loc:Location.t -> pattern list -> pattern
-    val or_: ?loc:Location.t -> pattern -> pattern -> pattern
-    val constraint_: ?loc:Location.t -> pattern -> core_type -> pattern
-    val type_: ?loc:Location.t -> Longident.t loc -> pattern
-    val lazy_: ?loc:Location.t -> pattern -> pattern
-    val unpack: ?loc:Location.t -> string loc -> pattern
-    val map: mapper -> pattern -> pattern
-  end
-
-module CE:
-  sig
-    val mk: ?loc:Location.t -> class_expr_desc -> class_expr
-    val structure: ?loc:Location.t -> class_structure -> class_expr
-    val fun_: ?loc:Location.t -> label -> expression option -> pattern -> class_expr -> class_expr
-    val apply: ?loc:Location.t -> class_expr -> (label * expression) list -> class_expr
-    val let_: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> class_expr -> class_expr
-    val constraint_: ?loc:Location.t -> class_expr -> class_type -> class_expr
-    val map: mapper -> class_expr -> class_expr
-    val mk_field: ?loc:Location.t -> class_field_desc -> class_field
-    val inher: ?loc:Location.t -> override_flag -> class_expr -> string option -> class_field
-    val valvirt: ?loc:Location.t -> string loc -> mutable_flag -> core_type -> class_field
-    val val_: ?loc:Location.t -> string loc -> mutable_flag -> override_flag -> expression -> class_field
-    val virt: ?loc:Location.t -> string loc -> private_flag -> core_type -> class_field
-    val meth: ?loc:Location.t -> string loc -> private_flag -> override_flag -> expression -> class_field
-    val constr: ?loc:Location.t -> core_type -> core_type -> class_field
-    val init: ?loc:Location.t -> expression -> class_field
-    val map_field: mapper -> class_field -> class_field
-    val map_structure: mapper -> class_structure -> class_structure
-    val class_infos: mapper -> ('a -> 'b) -> 'a class_infos -> 'b class_infos
-  end
diff --git a/parsing/asttypes.mli b/parsing/asttypes.mli
index fb6d5ba09..b212a2b9a 100644
--- a/parsing/asttypes.mli
+++ b/parsing/asttypes.mli
@@ -15,13 +15,13 @@
 type constant =
     Const_int of int
   | Const_char of char
-  | Const_string of string
+  | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
   | Const_int64 of int64
   | Const_nativeint of nativeint
 
-type rec_flag = Nonrecursive | Recursive | Default
+type rec_flag = Nonrecursive | Recursive
 
 type direction_flag = Upto | Downto
 
@@ -41,3 +41,9 @@ type 'a loc = 'a Location.loc = {
   txt : 'a;
   loc : Location.t;
 }
+
+
+type variance =
+  | Covariant
+  | Contravariant
+  | Invariant
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index ae69b37f7..8b34b2483 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -111,12 +111,14 @@ let store_string_char c =
   String.unsafe_set (!string_buff) (!string_index) c;
   incr string_index
 
-let store_lexeme lexbuf =
-  let s = Lexing.lexeme lexbuf in
+let store_string s =
   for i = 0 to String.length s - 1 do
     store_string_char s.[i];
   done
 
+let store_lexeme lexbuf =
+  store_string (Lexing.lexeme lexbuf)
+
 let get_stored_string () =
   let s = String.sub (!string_buff) 0 (!string_index) in
   string_buff := initial_string_buffer;
@@ -332,7 +334,18 @@ rule token = parse
         string lexbuf;
         is_in_string := false;
         lexbuf.lex_start_p <- string_start;
-        STRING (get_stored_string()) }
+        STRING (get_stored_string(), None) }
+  | "{" lowercase* "|"
+      { reset_string_buffer();
+        let delim = Lexing.lexeme lexbuf in
+        let delim = String.sub delim 1 (String.length delim - 2) in
+        is_in_string := true;
+        let string_start = lexbuf.lex_start_p in
+        string_start_loc := Location.curr lexbuf;
+        quoted_string delim lexbuf;
+        is_in_string := false;
+        lexbuf.lex_start_p <- string_start;
+        STRING (get_stored_string(), Some delim) }
   | "'" newline "'"
       { update_loc lexbuf None 1 false 1;
         CHAR (Lexing.lexeme_char lexbuf 1) }
@@ -419,8 +432,11 @@ rule token = parse
   | ">]" { GREATERRBRACKET }
   | "}"  { RBRACE }
   | ">}" { GREATERRBRACE }
+  | "[@" { LBRACKETAT }
+  | "[%" { LBRACKETPERCENT }
+  | "[%%" { LBRACKETPERCENTPERCENT }
+  | "[@@" { LBRACKETATAT }
   | "!"  { BANG }
-
   | "!=" { INFIXOP0 "!=" }
   | "+"  { PLUS }
   | "+." { PLUSDOT }
@@ -439,6 +455,7 @@ rule token = parse
             { INFIXOP2(Lexing.lexeme lexbuf) }
   | "**" symbolchar *
             { INFIXOP4(Lexing.lexeme lexbuf) }
+  | '%'     { PERCENT }
   | ['*' '/' '%'] symbolchar *
             { INFIXOP3(Lexing.lexeme lexbuf) }
   | eof { EOF }
@@ -478,6 +495,28 @@ and comment = parse
         is_in_string := false;
         store_string_char '"';
         comment lexbuf }
+  | "{" lowercase* "|"
+      {
+        let delim = Lexing.lexeme lexbuf in
+        let delim = String.sub delim 1 (String.length delim - 2) in
+        string_start_loc := Location.curr lexbuf;
+        store_lexeme lexbuf;
+        is_in_string := true;
+        begin try quoted_string delim lexbuf
+        with Error (Unterminated_string, _) ->
+          match !comment_start_loc with
+          | [] -> assert false
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            raise (Error (Unterminated_string_in_comment start, loc))
+        end;
+        is_in_string := false;
+        store_string_char '|';
+        store_string delim;
+        store_string_char '}';
+        comment lexbuf }
+
   | "''"
       { store_lexeme lexbuf; comment lexbuf }
   | "'" newline "'"
@@ -554,6 +593,26 @@ and string = parse
       { store_string_char(Lexing.lexeme_char lexbuf 0);
         string lexbuf }
 
+and quoted_string delim = parse
+  | newline
+      { update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        quoted_string delim lexbuf
+      }
+  | eof
+      { is_in_string := false;
+        raise (Error (Unterminated_string, !string_start_loc)) }
+  | "|" lowercase* "}"
+      {
+        let edelim = Lexing.lexeme lexbuf in
+        let edelim = String.sub edelim 1 (String.length edelim - 2) in
+        if delim = edelim then ()
+        else (store_lexeme lexbuf; quoted_string delim lexbuf)
+      }
+  | _
+      { store_string_char(Lexing.lexeme_char lexbuf 0);
+        quoted_string delim lexbuf }
+
 and skip_sharp_bang = parse
   | "#!" [^ '\n']* '\n' [^ '\n']* "\n!#\n"
        { update_loc lexbuf None 3 false 0 }
diff --git a/parsing/parse.ml b/parsing/parse.ml
index aef957d64..ab84b13d4 100644
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -59,3 +59,6 @@ let implementation = wrap Parser.implementation
 and interface = wrap Parser.interface
 and toplevel_phrase = wrap Parser.toplevel_phrase
 and use_file = wrap Parser.use_file
+and core_type = wrap Parser.parse_core_type
+and expression = wrap Parser.parse_expression
+and pattern = wrap Parser.parse_pattern
diff --git a/parsing/parse.mli b/parsing/parse.mli
index abdde31cf..9d17a24b3 100644
--- a/parsing/parse.mli
+++ b/parsing/parse.mli
@@ -16,3 +16,6 @@ val implementation : Lexing.lexbuf -> Parsetree.structure
 val interface : Lexing.lexbuf -> Parsetree.signature
 val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase
 val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
+val core_type : Lexing.lexbuf -> Parsetree.core_type
+val expression : Lexing.lexbuf -> Parsetree.expression
+val pattern : Lexing.lexbuf -> Parsetree.pattern
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 429d6bec0..343f7c73b 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -17,46 +17,34 @@ open Location
 open Asttypes
 open Longident
 open Parsetree
+open Ast_helper
+
+let mktyp d = Typ.mk ~loc:(symbol_rloc()) d
+let mkpat d = Pat.mk ~loc:(symbol_rloc()) d
+let mkexp d = Exp.mk ~loc:(symbol_rloc()) d
+let mkmty d = Mty.mk ~loc:(symbol_rloc()) d
+let mksig d = Sig.mk ~loc:(symbol_rloc()) d
+let mkmod d = Mod.mk ~loc:(symbol_rloc()) d
+let mkstr d = Str.mk ~loc:(symbol_rloc()) d
+let mkclass d = Cl.mk ~loc:(symbol_rloc()) d
+let mkcty d = Cty.mk ~loc:(symbol_rloc()) d
+let mkctf d = Ctf.mk ~loc:(symbol_rloc()) d
+let mkcf d = Cf.mk ~loc:(symbol_rloc()) d
 
-let mktyp d =
-  { ptyp_desc = d; ptyp_loc = symbol_rloc() }
-let mkpat d =
-  { ppat_desc = d; ppat_loc = symbol_rloc() }
-let mkexp d =
-  { pexp_desc = d; pexp_loc = symbol_rloc() }
-let mkmty d =
-  { pmty_desc = d; pmty_loc = symbol_rloc() }
-let mksig d =
-  { psig_desc = d; psig_loc = symbol_rloc() }
-let mkmod d =
-  { pmod_desc = d; pmod_loc = symbol_rloc() }
-let mkstr d =
-  { pstr_desc = d; pstr_loc = symbol_rloc() }
-let mkfield d =
-  { pfield_desc = d; pfield_loc = symbol_rloc() }
-let mkclass d =
-  { pcl_desc = d; pcl_loc = symbol_rloc() }
-let mkcty d =
-  { pcty_desc = d; pcty_loc = symbol_rloc() }
-let mkctf d =
-  { pctf_desc = d; pctf_loc = symbol_rloc () }
-let mkcf d =
-  { pcf_desc = d; pcf_loc = symbol_rloc () }
 let mkrhs rhs pos = mkloc rhs (rhs_loc pos)
 let mkoption d =
   let loc = {d.ptyp_loc with loc_ghost = true} in
-  { ptyp_desc = Ptyp_constr(mkloc (Ldot (Lident "*predef*", "option")) loc,[d]);
-    ptyp_loc = loc}
+  Typ.mk ~loc (Ptyp_constr(mkloc (Ldot (Lident "*predef*", "option")) loc,[d]))
 
 let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
 let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
 
 let mkoperator name pos =
   let loc = rhs_loc pos in
-  { pexp_desc = Pexp_ident(mkloc (Lident name) loc); pexp_loc = loc }
+  Exp.mk ~loc (Pexp_ident(mkloc (Lident name) loc))
 
 let mkpatvar name pos =
-  { ppat_desc = Ppat_var (mkrhs name pos); ppat_loc = rhs_loc pos }
+  Pat.mk ~loc:(rhs_loc pos) (Ppat_var (mkrhs name pos))
 
 (*
   Ghost expressions and patterns:
@@ -75,18 +63,13 @@ let mkpatvar name pos =
   AST node, then the location must be real; in all other cases,
   it must be ghost.
 *)
-let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
-let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
-let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
-let ghloc d = { txt = d; loc = symbol_gloc () };;
-
-let mkassert e =
-  match e with
-  | {pexp_desc = Pexp_construct ({ txt = Lident "false" }, None , false);
-     pexp_loc = _ } ->
-         mkexp (Pexp_assertfalse)
-  | _ -> mkexp (Pexp_assert (e))
-;;
+let ghexp d = Exp.mk ~loc:(symbol_gloc ()) d
+let ghpat d = Pat.mk ~loc:(symbol_gloc ()) d
+let ghtyp d = Typ.mk ~loc:(symbol_gloc ()) d
+let ghloc d = { txt = d; loc = symbol_gloc () }
+
+let ghunit () =
+  ghexp (Pexp_construct (mknoloc (Lident "()"), None))
 
 let mkinfix arg1 name arg2 =
   mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))
@@ -123,57 +106,51 @@ let mkuplus name arg =
       mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
 
 let mkexp_cons consloc args loc =
-  {pexp_desc = Pexp_construct(mkloc (Lident "::") consloc, Some args, false);
-   pexp_loc = loc}
+  Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args))
 
 let mkpat_cons consloc args loc =
-  {ppat_desc = Ppat_construct(mkloc (Lident "::") consloc, Some args, false);
-   ppat_loc = loc}
+  Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args))
 
 let rec mktailexp nilloc = function
     [] ->
       let loc = { nilloc with loc_ghost = true } in
       let nil = { txt = Lident "[]"; loc = loc } in
-      { pexp_desc = Pexp_construct (nil, None, false); pexp_loc = loc }
+      Exp.mk ~loc (Pexp_construct (nil, None))
   | e1 :: el ->
       let exp_el = mktailexp nilloc el in
-      let l = {loc_start = e1.pexp_loc.loc_start;
+      let loc = {loc_start = e1.pexp_loc.loc_start;
                loc_end = exp_el.pexp_loc.loc_end;
                loc_ghost = true}
       in
-      let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
-      mkexp_cons {l with loc_ghost = true} arg l
+      let arg = Exp.mk ~loc (Pexp_tuple [e1; exp_el]) in
+      mkexp_cons {loc with loc_ghost = true} arg loc
 
 let rec mktailpat nilloc = function
     [] ->
       let loc = { nilloc with loc_ghost = true } in
       let nil = { txt = Lident "[]"; loc = loc } in
-      { ppat_desc = Ppat_construct (nil, None, false); ppat_loc = loc }
+      Pat.mk ~loc (Ppat_construct (nil, None))
   | p1 :: pl ->
       let pat_pl = mktailpat nilloc pl in
-      let l = {loc_start = p1.ppat_loc.loc_start;
+      let loc = {loc_start = p1.ppat_loc.loc_start;
                loc_end = pat_pl.ppat_loc.loc_end;
                loc_ghost = true}
       in
-      let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
-      mkpat_cons {l with loc_ghost = true} arg l
+      let arg = Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in
+      mkpat_cons {loc with loc_ghost = true} arg loc
+
+let mkstrexp e attrs =
+  { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
 
-let mkstrexp e =
-  { pstr_desc = Pstr_eval e; pstr_loc = e.pexp_loc }
+let mkexp_constraint e (t1, t2) =
+  match t1, t2 with
+  | Some t, None -> ghexp(Pexp_constraint(e, t))
+  | _, Some t -> ghexp(Pexp_coerce(e, t1, t))
+  | None, None -> assert false
 
 let array_function str name =
   ghloc (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name)))
 
-let rec deep_mkrangepat c1 c2 =
-  if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
-  ghpat(Ppat_or(ghpat(Ppat_constant(Const_char c1)),
-                deep_mkrangepat (Char.chr(Char.code c1 + 1)) c2))
-
-let rec mkrangepat c1 c2 =
-  if c1 > c2 then mkrangepat c2 c1 else
-  if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
-  reloc_pat (deep_mkrangepat c1 c2)
-
 let syntax_error () =
   raise Syntaxerr.Escape_error
 
@@ -184,6 +161,9 @@ let unclosed opening_name opening_num closing_name closing_num =
 let expecting pos nonterm =
     raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))
 
+let not_expecting pos nonterm =
+    raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm)))
+
 let bigarray_function str name =
   ghloc (Ldot(Ldot(Lident "Bigarray", str), name))
 
@@ -255,10 +235,10 @@ let varify_constructors var_names t =
           Ptyp_var s
       | Ptyp_constr(longident, lst) ->
           Ptyp_constr(longident, List.map loop lst)
-      | Ptyp_object lst ->
-          Ptyp_object (List.map loop_core_field lst)
-      | Ptyp_class (longident, lst, lbl_list) ->
-          Ptyp_class (longident, List.map loop lst, lbl_list)
+      | Ptyp_object (lst, o) ->
+          Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+      | Ptyp_class (longident, lst) ->
+          Ptyp_class (longident, List.map loop lst)
       | Ptyp_alias(core_type, string) ->
           check_variable var_names t.ptyp_loc string;
           Ptyp_alias(loop core_type, string)
@@ -270,17 +250,10 @@ let varify_constructors var_names t =
           Ptyp_poly(string_lst, loop core_type)
       | Ptyp_package(longident,lst) ->
           Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+      | Ptyp_extension (s, arg) ->
+          Ptyp_extension (s, arg)
     in
     {t with ptyp_desc = desc}
-  and loop_core_field t =
-    let desc =
-      match t.pfield_desc with
-      | Pfield(n,typ) ->
-          Pfield(n,loop typ)
-      | Pfield_var ->
-          Pfield_var
-    in
-    { t with pfield_desc=desc}
   and loop_row_field  =
     function
       | Rtag(label,flag,lst) ->
@@ -291,13 +264,23 @@ let varify_constructors var_names t =
   loop t
 
 let wrap_type_annotation newtypes core_type body =
-  let exp = mkexp(Pexp_constraint(body,Some core_type,None)) in
+  let exp = mkexp(Pexp_constraint(body,core_type)) in
   let exp =
     List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
       newtypes exp
   in
   (exp, ghtyp(Ptyp_poly(newtypes,varify_constructors newtypes core_type)))
 
+let wrap_exp_attrs body (ext, attrs) =
+  (* todo: keep exact location for the entire attribute *)
+  let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
+  match ext with
+  | None -> body
+  | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
+
+let mkexp_attrs d attrs =
+  wrap_exp_attrs (mkexp d) attrs
+
 %}
 
 /* Tokens */
@@ -362,11 +345,15 @@ let wrap_type_annotation newtypes core_type body =
 %token LBRACKETBAR
 %token LBRACKETLESS
 %token LBRACKETGREATER
+%token LBRACKETPERCENT
+%token LBRACKETPERCENTPERCENT
 %token LESS
 %token LESSMINUS
 %token LET
 %token <string> LIDENT
 %token LPAREN
+%token LBRACKETAT
+%token LBRACKETATAT
 %token MATCH
 %token METHOD
 %token MINUS
@@ -382,6 +369,7 @@ let wrap_type_annotation newtypes core_type body =
 %token <string> OPTLABEL
 %token OR
 /* %token PARSER */
+%token PERCENT
 %token PLUS
 %token PLUSDOT
 %token <string> PREFIXOP
@@ -397,7 +385,7 @@ let wrap_type_annotation newtypes core_type body =
 %token SHARP
 %token SIG
 %token STAR
-%token <string> STRING
+%token <string * string option> STRING
 %token STRUCT
 %token THEN
 %token TILDE
@@ -458,9 +446,14 @@ The precedences must be listed from low to high.
 %nonassoc below_EQUAL
 %left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
 %right    INFIXOP1                      /* expr (e OP e OP e) */
+%nonassoc below_LBRACKETAT
+%nonassoc LBRACKETAT
+%nonassoc LBRACKETATAT
+%nonassoc LBRACKETPERCENT
+%nonassoc LBRACKETPERCENTPERCENT
 %right    COLONCOLON                    /* expr (e :: e :: e) */
 %left     INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT  /* expr (e OP e OP e) */
-%left     INFIXOP3 STAR                 /* expr (e OP e OP e) */
+%left     PERCENT INFIXOP3 STAR                 /* expr (e OP e OP e) */
 %right    INFIXOP4                      /* expr (e OP e OP e) */
 %nonassoc prec_unary_minus prec_unary_plus /* unary - */
 %nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
@@ -485,8 +478,12 @@ The precedences must be listed from low to high.
 %type <Parsetree.toplevel_phrase> toplevel_phrase
 %start use_file                         /* for the #use directive */
 %type <Parsetree.toplevel_phrase list> use_file
-%start any_longident
-%type <Longident.t> any_longident
+%start parse_core_type
+%type <Parsetree.core_type> parse_core_type
+%start parse_expression
+%type <Parsetree.expression> parse_expression
+%start parse_pattern
+%type <Parsetree.pattern> parse_pattern
 %%
 
 /* Entry points */
@@ -495,11 +492,11 @@ implementation:
     structure EOF                        { $1 }
 ;
 interface:
-    signature EOF                        { List.rev $1 }
+    signature EOF                        { $1 }
 ;
 toplevel_phrase:
     top_structure SEMISEMI               { Ptop_def $1 }
-  | seq_expr SEMISEMI                    { Ptop_def[mkstrexp $1] }
+  | seq_expr post_item_attributes SEMISEMI                    { Ptop_def[mkstrexp $1 $2] }
   | toplevel_directive SEMISEMI          { $1 }
   | EOF                                  { raise End_of_file }
 ;
@@ -509,17 +506,26 @@ top_structure:
 ;
 use_file:
     use_file_tail                        { $1 }
-  | seq_expr use_file_tail               { Ptop_def[mkstrexp $1] :: $2 }
+  | seq_expr post_item_attributes use_file_tail               { Ptop_def[mkstrexp $1 $2] :: $3 }
 ;
 use_file_tail:
     EOF                                         { [] }
   | SEMISEMI EOF                                { [] }
-  | SEMISEMI seq_expr use_file_tail             { Ptop_def[mkstrexp $2] :: $3 }
+  | SEMISEMI seq_expr post_item_attributes use_file_tail             { Ptop_def[mkstrexp $2 $3] :: $4 }
   | SEMISEMI structure_item use_file_tail       { Ptop_def[$2] :: $3 }
   | SEMISEMI toplevel_directive use_file_tail   { $2 :: $3 }
   | structure_item use_file_tail                { Ptop_def[$1] :: $2 }
   | toplevel_directive use_file_tail            { $1 :: $2 }
 ;
+parse_core_type:
+    core_type EOF { $1 }
+;
+parse_expression:
+    seq_expr EOF { $1 }
+;
+parse_pattern:
+    pattern EOF { $1 }
+;
 
 /* Module expressions */
 
@@ -548,75 +554,97 @@ module_expr:
       { mkmod(Pmod_unpack $3) }
   | LPAREN VAL expr COLON package_type RPAREN
       { mkmod(Pmod_unpack(
-              ghexp(Pexp_constraint($3, Some(ghtyp(Ptyp_package $5)), None)))) }
+              ghexp(Pexp_constraint($3, ghtyp(Ptyp_package $5))))) }
   | LPAREN VAL expr COLON package_type COLONGREATER package_type RPAREN
       { mkmod(Pmod_unpack(
-              ghexp(Pexp_constraint($3, Some(ghtyp(Ptyp_package $5)),
-                                    Some(ghtyp(Ptyp_package $7)))))) }
+              ghexp(Pexp_coerce($3, Some(ghtyp(Ptyp_package $5)),
+                                    ghtyp(Ptyp_package $7))))) }
   | LPAREN VAL expr COLONGREATER package_type RPAREN
       { mkmod(Pmod_unpack(
-              ghexp(Pexp_constraint($3, None, Some(ghtyp(Ptyp_package $5)))))) }
+              ghexp(Pexp_coerce($3, None, ghtyp(Ptyp_package $5))))) }
   | LPAREN VAL expr COLON error
       { unclosed "(" 1 ")" 5 }
   | LPAREN VAL expr COLONGREATER error
       { unclosed "(" 1 ")" 5 }
   | LPAREN VAL expr error
       { unclosed "(" 1 ")" 4 }
+  | module_expr attribute
+      { Mod.attr $1 $2 }
+  | extension
+      { mkmod(Pmod_extension $1) }
 ;
+
 structure:
-    structure_tail                              { $1 }
-  | seq_expr structure_tail                     { mkstrexp $1 :: $2 }
+    str_attribute structure { $1 :: $2 }
+  | seq_expr post_item_attributes structure_tail { mkstrexp $1 $2 :: $3 }
+  | structure_tail { $1 }
 ;
 structure_tail:
-    /* empty */                                 { [] }
-  | SEMISEMI                                    { [] }
-  | SEMISEMI seq_expr structure_tail            { mkstrexp $2 :: $3 }
-  | SEMISEMI structure_item structure_tail      { $2 :: $3 }
-  | structure_item structure_tail               { $1 :: $2 }
+    /* empty */          { [] }
+  | SEMISEMI structure   { $2 }
+  | structure_item structure_tail { $1 :: $2 }
+;
+str_attribute:
+    post_item_attribute { mkstr(Pstr_attribute $1) }
 ;
 structure_item:
-    LET rec_flag let_bindings
-      { match $3 with
-          [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
-        | _ -> mkstr(Pstr_value($2, List.rev $3)) }
-  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
-      { mkstr(Pstr_primitive(mkrhs $2 2, {pval_type = $4; pval_prim = $6;
-          pval_loc = symbol_rloc ()})) }
+    LET ext_attributes rec_flag let_bindings
+      {
+        match $4 with
+          [ {pvb_pat = { ppat_desc = Ppat_any; ppat_loc = _ }; pvb_expr = exp; pvb_attributes = attrs}] ->
+            let exp = wrap_exp_attrs exp $2 in
+            mkstr(Pstr_eval (exp, attrs))
+        | l ->
+            begin match $2 with
+            | None, [] -> mkstr(Pstr_value($3, List.rev l))
+            | Some _, _ -> not_expecting 2 "extension"
+            | None, _ :: _ -> not_expecting 2 "attribute"
+            end
+      }
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
+      { mkstr
+          (Pstr_primitive (Val.mk (mkrhs $2 2) $4
+                             ~prim:$6 ~attrs:$7 ~loc:(symbol_rloc ()))) }
   | TYPE type_declarations
-      { mkstr(Pstr_type(List.rev $2)) }
-  | EXCEPTION UIDENT constructor_arguments
-      { mkstr(Pstr_exception(mkrhs $2 2, $3)) }
-  | EXCEPTION UIDENT EQUAL constr_longident
-      { mkstr(Pstr_exn_rebind(mkrhs $2 2, mkloc $4 (rhs_loc 4))) }
-  | MODULE UIDENT module_binding
-      { mkstr(Pstr_module(mkrhs $2 2, $3)) }
-  | MODULE REC module_rec_bindings
+      { mkstr(Pstr_type (List.rev $2) ) }
+  | EXCEPTION exception_declaration
+      { mkstr(Pstr_exception $2) }
+  | EXCEPTION UIDENT EQUAL constr_longident post_item_attributes
+      { mkstr(Pstr_exn_rebind(mkrhs $2 2, mkloc $4 (rhs_loc 4), $5)) }
+  | MODULE module_binding
+      { mkstr(Pstr_module $2) }
+  | MODULE REC module_bindings
       { mkstr(Pstr_recmodule(List.rev $3)) }
-  | MODULE TYPE ident EQUAL module_type
-      { mkstr(Pstr_modtype(mkrhs $3 3, $5)) }
-  | OPEN override_flag mod_longident
-      { mkstr(Pstr_open ($2, mkrhs $3 3)) }
+  | MODULE TYPE ident post_item_attributes
+      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3) ~attrs:$4)) }
+  | MODULE TYPE ident EQUAL module_type post_item_attributes
+      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5 ~attrs:$6)) }
+  | OPEN override_flag mod_longident post_item_attributes
+      { mkstr(Pstr_open ($2, mkrhs $3 3, $4)) }
   | CLASS class_declarations
       { mkstr(Pstr_class (List.rev $2)) }
   | CLASS TYPE class_type_declarations
       { mkstr(Pstr_class_type (List.rev $3)) }
-  | INCLUDE module_expr
-      { mkstr(Pstr_include $2) }
+  | INCLUDE module_expr post_item_attributes
+      { mkstr(Pstr_include ($2, $3)) }
+  | item_extension post_item_attributes
+      { mkstr(Pstr_extension ($1, $2)) }
 ;
-module_binding:
+module_binding_body:
     EQUAL module_expr
       { $2 }
   | COLON module_type EQUAL module_expr
       { mkmod(Pmod_constraint($4, $2)) }
-  | LPAREN UIDENT COLON module_type RPAREN module_binding
+  | LPAREN UIDENT COLON module_type RPAREN module_binding_body
       { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
 ;
-module_rec_bindings:
-    module_rec_binding                            { [$1] }
-  | module_rec_bindings AND module_rec_binding    { $3 :: $1 }
+module_bindings:
+    module_binding                        { [$1] }
+  | module_bindings AND module_binding    { $3 :: $1 }
 ;
-module_rec_binding:
-    UIDENT COLON module_type EQUAL module_expr    { (mkrhs $1 1, $3, $5) }
+module_binding:
+    UIDENT module_binding_body post_item_attributes
+    { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 }
 ;
 
 /* Module types */
@@ -625,7 +653,7 @@ module_type:
     mty_longident
       { mkmty(Pmty_ident (mkrhs $1 1)) }
   | SIG signature END
-      { mkmty(Pmty_signature(List.rev $2)) }
+      { mkmty(Pmty_signature $2) }
   | SIG signature error
       { unclosed "sig" 1 "end" 3 }
   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
@@ -633,45 +661,59 @@ module_type:
       { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
-  | MODULE TYPE OF module_expr
+  | MODULE TYPE OF module_expr %prec below_LBRACKETAT
       { mkmty(Pmty_typeof $4) }
   | LPAREN module_type RPAREN
       { $2 }
   | LPAREN module_type error
       { unclosed "(" 1 ")" 3 }
+  | extension
+      { mkmty(Pmty_extension $1) }
+  | module_type attribute
+      { Mty.attr $1 $2 }
 ;
 signature:
-    /* empty */                                 { [] }
-  | signature signature_item                    { $2 :: $1 }
-  | signature signature_item SEMISEMI           { $2 :: $1 }
+    sig_attribute signature { $1 :: $2 }
+  | signature_tail { $1 }
+;
+signature_tail:
+    /* empty */          { [] }
+  | SEMISEMI signature   { $2 }
+  | signature_item signature_tail { $1 :: $2 }
+;
+sig_attribute:
+    post_item_attribute { mksig(Psig_attribute $1) }
 ;
 signature_item:
-    VAL val_ident COLON core_type
-      { mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = [];
-          pval_loc = symbol_rloc()})) }
-  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
-      { mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = $6;
-          pval_loc = symbol_rloc()})) }
+    VAL val_ident COLON core_type post_item_attributes
+      { mksig(Psig_value
+                (Val.mk (mkrhs $2 2) $4 ~attrs:$5 ~loc:(symbol_rloc()))) }
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
+      { mksig(Psig_value
+                (Val.mk (mkrhs $2 2) $4 ~prim:$6 ~attrs:$7
+                   ~loc:(symbol_rloc()))) }
   | TYPE type_declarations
-      { mksig(Psig_type(List.rev $2)) }
-  | EXCEPTION UIDENT constructor_arguments
-      { mksig(Psig_exception(mkrhs $2 2, $3)) }
-  | MODULE UIDENT module_declaration
-      { mksig(Psig_module(mkrhs $2 2, $3)) }
+      { mksig(Psig_type (List.rev $2)) }
+  | EXCEPTION exception_declaration
+      { mksig(Psig_exception $2) }
+  | MODULE UIDENT module_declaration post_item_attributes
+      { mksig(Psig_module (Md.mk (mkrhs $2 2) $3 ~attrs:$4)) }
   | MODULE REC module_rec_declarations
-      { mksig(Psig_recmodule(List.rev $3)) }
-  | MODULE TYPE ident
-      { mksig(Psig_modtype(mkrhs $3 3, Pmodtype_abstract)) }
-  | MODULE TYPE ident EQUAL module_type
-      { mksig(Psig_modtype(mkrhs $3 3, Pmodtype_manifest $5)) }
-  | OPEN override_flag mod_longident
-      { mksig(Psig_open ($2, mkrhs $3 3)) }
-  | INCLUDE module_type
-      { mksig(Psig_include $2) }
+      { mksig(Psig_recmodule (List.rev $3)) }
+  | MODULE TYPE ident post_item_attributes
+      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~attrs:$4)) }
+  | MODULE TYPE ident EQUAL module_type post_item_attributes
+      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5 ~attrs:$6)) }
+  | OPEN override_flag mod_longident post_item_attributes
+      { mksig(Psig_open ($2, mkrhs $3 3, $4)) }
+  | INCLUDE module_type post_item_attributes %prec below_WITH
+      { mksig(Psig_include ($2, $3)) }
   | CLASS class_descriptions
       { mksig(Psig_class (List.rev $2)) }
   | CLASS TYPE class_type_declarations
       { mksig(Psig_class_type (List.rev $3)) }
+  | item_extension post_item_attributes
+      { mksig(Psig_extension ($1, $2)) }
 ;
 
 module_declaration:
@@ -685,7 +727,8 @@ module_rec_declarations:
   | module_rec_declarations AND module_rec_declaration  { $3 :: $1 }
 ;
 module_rec_declaration:
-    UIDENT COLON module_type                            { (mkrhs $1 1, $3) }
+    UIDENT COLON module_type post_item_attributes
+    { Md.mk (mkrhs $1 1) $3 ~attrs:$4 }
 ;
 
 /* Class expressions */
@@ -695,11 +738,12 @@ class_declarations:
   | class_declaration                           { [$1] }
 ;
 class_declaration:
-    virtual_flag class_type_parameters LIDENT class_fun_binding
-      { let params, variance = List.split (fst $2) in
-        {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = mkrhs $3 3; pci_expr = $4; pci_variance = variance;
-         pci_loc = symbol_rloc ()} }
+    virtual_flag class_type_parameters LIDENT class_fun_binding post_item_attributes
+      {
+       Ci.mk (mkrhs $3 3) $4
+         ~virt:$1 ~params:$2
+         ~attrs:$5 ~loc:(symbol_rloc ())
+      }
 ;
 class_fun_binding:
     EQUAL class_expr
@@ -710,8 +754,8 @@ class_fun_binding:
       { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $2)) }
 ;
 class_type_parameters:
-    /*empty*/                                   { [], symbol_gloc () }
-  | LBRACKET type_parameter_list RBRACKET       { List.rev $2, symbol_rloc () }
+    /*empty*/                                   { [] }
+  | LBRACKET type_parameter_list RBRACKET       { List.rev $2 }
 ;
 class_fun_def:
     labeled_simple_pattern MINUSGREATER class_expr
@@ -728,6 +772,10 @@ class_expr:
       { mkclass(Pcl_apply($1, List.rev $2)) }
   | LET rec_flag let_bindings IN class_expr
       { mkclass(Pcl_let ($2, List.rev $3, $5)) }
+  | class_expr attribute
+      { Cl.attr $1 $2 }
+  | extension
+      { mkclass(Pcl_extension $1) }
 ;
 class_simple_expr:
     LBRACKET core_type_comma_list RBRACKET class_longident
@@ -749,7 +797,7 @@ class_simple_expr:
 ;
 class_structure:
     class_self_pattern class_fields
-      { { pcstr_pat = $1; pcstr_fields = List.rev $2 } }
+      { Cstr.mk $1 (List.rev $2) }
 ;
 class_self_pattern:
     LPAREN pattern RPAREN
@@ -767,19 +815,18 @@ class_fields:
 ;
 class_field:
   | INHERIT override_flag class_expr parent_binder
-      { mkcf (Pcf_inher ($2, $3, $4)) }
-  | VAL virtual_value
-      { mkcf (Pcf_valvirt $2) }
+      { mkcf (Pcf_inherit ($2, $3, $4)) }
   | VAL value
       { mkcf (Pcf_val $2) }
-  | virtual_method
-      { mkcf (Pcf_virt $1) }
-  | concrete_method
-      { mkcf (Pcf_meth $1) }
+  | METHOD method_
+      { mkcf (Pcf_method $2) }
   | CONSTRAINT constrain_field
-      { mkcf (Pcf_constr $2) }
+      { mkcf (Pcf_constraint $2) }
   | INITIALIZER seq_expr
-      { mkcf (Pcf_init $2) }
+      { mkcf (Pcf_initializer $2) }
+  | class_field post_item_attribute
+      { Cf.attr $1 $2 }
+  | item_extension { mkcf(Pcf_extension $1) }
 ;
 parent_binder:
     AS LIDENT
@@ -787,37 +834,37 @@ parent_binder:
   | /* empty */
           { None }
 ;
-virtual_value:
+value:
+/* TODO: factorize these rules (also with method): */
     override_flag MUTABLE VIRTUAL label COLON core_type
       { if $1 = Override then syntax_error ();
-        mkloc $4 (rhs_loc 4), Mutable, $6 }
+        mkloc $4 (rhs_loc 4), Mutable, Cfk_virtual $6 }
   | VIRTUAL mutable_flag label COLON core_type
-      { mkrhs $3 3, $2, $5 }
-;
-value:
-    override_flag mutable_flag label EQUAL seq_expr
-      { mkrhs $3 3, $2, $1, $5 }
+      { mkrhs $3 3, $2, Cfk_virtual $5 }
+  | override_flag mutable_flag label EQUAL seq_expr
+      { mkrhs $3 3, $2, Cfk_concrete ($1, $5) }
   | override_flag mutable_flag label type_constraint EQUAL seq_expr
-      { let (t, t') = $4 in
-        mkrhs $3 3, $2, $1, ghexp(Pexp_constraint($6, t, t')) }
-;
-virtual_method:
-    METHOD override_flag PRIVATE VIRTUAL label COLON poly_type
-      { if $2 = Override then syntax_error ();
-        mkloc $5 (rhs_loc 5), Private, $7 }
-  | METHOD override_flag VIRTUAL private_flag label COLON poly_type
-      { if $2 = Override then syntax_error ();
-        mkloc $5 (rhs_loc 5), $4, $7 }
-;
-concrete_method :
-    METHOD override_flag private_flag label strict_binding
-      { mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly ($5, None)) }
-  | METHOD override_flag private_flag label COLON poly_type EQUAL seq_expr
-      { mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly($8,Some $6)) }
-  | METHOD override_flag private_flag label COLON TYPE lident_list
+      {
+       let e = mkexp_constraint $6 $4 in
+       mkrhs $3 3, $2, Cfk_concrete ($1, e)
+      }
+;
+method_:
+/* TODO: factorize those rules... */
+    override_flag PRIVATE VIRTUAL label COLON poly_type
+      { if $1 = Override then syntax_error ();
+        mkloc $4 (rhs_loc 4), Private, Cfk_virtual $6 }
+  | override_flag VIRTUAL private_flag label COLON poly_type
+      { if $1 = Override then syntax_error ();
+        mkloc $4 (rhs_loc 4), $3, Cfk_virtual $6 }
+  | override_flag private_flag label strict_binding
+      { mkloc $3 (rhs_loc 3), $2, Cfk_concrete ($1, ghexp(Pexp_poly ($4, None))) }
+  | override_flag private_flag label COLON poly_type EQUAL seq_expr
+      { mkloc $3 (rhs_loc 3), $2, Cfk_concrete ($1, ghexp(Pexp_poly($7, Some $5))) }
+  | override_flag private_flag label COLON TYPE lident_list
     DOT core_type EQUAL seq_expr
-      { let exp, poly = wrap_type_annotation $7 $9 $11 in
-        mkloc $4 (rhs_loc 4), $3, $2, ghexp(Pexp_poly(exp, Some poly)) }
+      { let exp, poly = wrap_type_annotation $6 $8 $10 in
+        mkloc $3 (rhs_loc 3), $2, Cfk_concrete ($1, ghexp(Pexp_poly(exp, Some poly))) }
 ;
 
 /* Class types */
@@ -825,14 +872,18 @@ concrete_method :
 class_type:
     class_signature
       { $1 }
-  | QUESTION LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $2 , mkoption $4, $6)) }
-  | OPTLABEL simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $1, mkoption $2, $4)) }
-  | LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun($1, $3, $5)) }
-  | simple_core_type_or_tuple MINUSGREATER class_type
-      { mkcty(Pcty_fun("", $1, $3)) }
+  | QUESTION LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type
+      { mkcty(Pcty_arrow("?" ^ $2 , mkoption $4, $6)) }
+  | OPTLABEL simple_core_type_or_tuple_no_attr MINUSGREATER class_type
+      { mkcty(Pcty_arrow("?" ^ $1, mkoption $2, $4)) }
+  | LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type
+      { mkcty(Pcty_arrow($1, $3, $5)) }
+  | simple_core_type_or_tuple_no_attr MINUSGREATER class_type
+      { mkcty(Pcty_arrow("", $1, $3)) }
+  | class_type attribute
+      { Cty.attr $1 $2 }
+  | extension
+      { mkcty(Pcty_extension $1) }
 ;
 class_signature:
     LBRACKET core_type_comma_list RBRACKET clty_longident
@@ -846,8 +897,7 @@ class_signature:
 ;
 class_sig_body:
     class_self_type class_sig_fields
-    { { pcsig_self = $1; pcsig_fields = List.rev $2;
-      pcsig_loc = symbol_rloc(); } }
+    { Csig.mk $1 (List.rev $2) }
 ;
 class_self_type:
     LPAREN core_type RPAREN
@@ -860,11 +910,16 @@ class_sig_fields:
 | class_sig_fields class_sig_field     { $2 :: $1 }
 ;
 class_sig_field:
-    INHERIT class_signature       { mkctf (Pctf_inher $2) }
+    INHERIT class_signature       { mkctf (Pctf_inherit $2) }
   | VAL value_type              { mkctf (Pctf_val $2) }
-  | virtual_method_type         { mkctf (Pctf_virt $1) }
-  | method_type                 { mkctf (Pctf_meth $1) }
-  | CONSTRAINT constrain_field        { mkctf (Pctf_cstr $2) }
+  | METHOD private_virtual_flags label COLON poly_type
+      {
+       let (p, v) = $2 in
+       mkctf (Pctf_method ($3, p, v, $5))
+      }
+  | CONSTRAINT constrain_field        { mkctf (Pctf_constraint $2) }
+  | class_sig_field post_item_attribute { Ctf.attr $1 $2 }
+  | item_extension { mkctf(Pctf_extension $1) }
 ;
 value_type:
     VIRTUAL mutable_flag label COLON core_type
@@ -874,16 +929,6 @@ value_type:
   | label COLON core_type
       { $1, Immutable, Concrete, $3 }
 ;
-method_type:
-    METHOD private_flag label COLON poly_type
-      { $3, $2, $5 }
-;
-virtual_method_type:
-    METHOD PRIVATE VIRTUAL label COLON poly_type
-      { $4, Private, $6 }
-  | METHOD VIRTUAL private_flag label COLON poly_type
-      { $4, $3, $6 }
-;
 constrain:
         core_type EQUAL core_type          { $1, $3, symbol_rloc() }
 ;
@@ -895,22 +940,24 @@ class_descriptions:
   | class_description                           { [$1] }
 ;
 class_description:
-    virtual_flag class_type_parameters LIDENT COLON class_type
-      { let params, variance = List.split (fst $2) in
-        {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = mkrhs $3 3; pci_expr = $5; pci_variance = variance;
-         pci_loc = symbol_rloc ()} }
+    virtual_flag class_type_parameters LIDENT COLON class_type post_item_attributes
+      {
+       Ci.mk (mkrhs $3 3) $5
+         ~virt:$1 ~params:$2
+         ~attrs:$6 ~loc:(symbol_rloc ())
+      }
 ;
 class_type_declarations:
     class_type_declarations AND class_type_declaration  { $3 :: $1 }
   | class_type_declaration                              { [$1] }
 ;
 class_type_declaration:
-    virtual_flag class_type_parameters LIDENT EQUAL class_signature
-      { let params, variance = List.split (fst $2) in
-        {pci_virt = $1; pci_params = params, snd $2;
-         pci_name = mkrhs $3 3; pci_expr = $5; pci_variance = variance;
-         pci_loc = symbol_rloc ()} }
+    virtual_flag class_type_parameters LIDENT EQUAL class_signature post_item_attributes
+      {
+       Ci.mk (mkrhs $3 3) $5
+         ~virt:$1 ~params:$2
+         ~attrs:$6 ~loc:(symbol_rloc ())
+      }
 ;
 
 /* Core expressions */
@@ -966,38 +1013,39 @@ expr:
       { $1 }
   | simple_expr simple_labeled_expr_list
       { mkexp(Pexp_apply($1, List.rev $2)) }
-  | LET rec_flag let_bindings IN seq_expr
-      { mkexp(Pexp_let($2, List.rev $3, $5)) }
-  | LET MODULE UIDENT module_binding IN seq_expr
-      { mkexp(Pexp_letmodule(mkrhs $3 3, $4, $6)) }
-  | LET OPEN override_flag mod_longident IN seq_expr
-      { mkexp(Pexp_open($3, mkrhs $4 4, $6)) }
-  | FUNCTION opt_bar match_cases
-      { mkexp(Pexp_function("", None, List.rev $3)) }
-  | FUN labeled_simple_pattern fun_def
-      { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
-  | FUN LPAREN TYPE LIDENT RPAREN fun_def
-      { mkexp(Pexp_newtype($4, $6)) }
-  | MATCH seq_expr WITH opt_bar match_cases
-      { mkexp(Pexp_match($2, List.rev $5)) }
-  | TRY seq_expr WITH opt_bar match_cases
-      { mkexp(Pexp_try($2, List.rev $5)) }
-  | TRY seq_expr WITH error
+  | LET ext_attributes rec_flag let_bindings IN seq_expr
+      { mkexp_attrs (Pexp_let($3, List.rev $4, $6)) $2 }
+  | LET MODULE ext_attributes UIDENT module_binding_body IN seq_expr
+      { mkexp_attrs (Pexp_letmodule(mkrhs $4 4, $5, $7)) $3 }
+  | LET OPEN override_flag ext_attributes mod_longident IN seq_expr
+      { mkexp_attrs (Pexp_open($3, mkrhs $5 5, $7)) $4 }
+  | FUNCTION ext_attributes opt_bar match_cases
+      { mkexp_attrs (Pexp_function(List.rev $4)) $2 }
+  | FUN ext_attributes labeled_simple_pattern fun_def
+      { let (l,o,p) = $3 in
+        mkexp_attrs (Pexp_fun(l, o, p, $4)) $2 }
+  | FUN ext_attributes LPAREN TYPE LIDENT RPAREN fun_def
+      { mkexp_attrs (Pexp_newtype($5, $7)) $2 }
+  | MATCH ext_attributes seq_expr WITH opt_bar match_cases
+      { mkexp_attrs (Pexp_match($3, List.rev $6)) $2 }
+  | TRY ext_attributes seq_expr WITH opt_bar match_cases
+      { mkexp_attrs (Pexp_try($3, List.rev $6)) $2 }
+  | TRY ext_attributes seq_expr WITH error
       { syntax_error() }
   | expr_comma_list %prec below_COMMA
       { mkexp(Pexp_tuple(List.rev $1)) }
   | constr_longident simple_expr %prec below_SHARP
-      { mkexp(Pexp_construct(mkrhs $1 1, Some $2, false)) }
+      { mkexp(Pexp_construct(mkrhs $1 1, Some $2)) }
   | name_tag simple_expr %prec below_SHARP
       { mkexp(Pexp_variant($1, Some $2)) }
-  | IF seq_expr THEN expr ELSE expr
-      { mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
-  | IF seq_expr THEN expr
-      { mkexp(Pexp_ifthenelse($2, $4, None)) }
-  | WHILE seq_expr DO seq_expr DONE
-      { mkexp(Pexp_while($2, $4)) }
-  | FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
-      { mkexp(Pexp_for(mkrhs $2 2, $4, $6, $5, $8)) }
+  | IF ext_attributes seq_expr THEN expr ELSE expr
+      { mkexp_attrs(Pexp_ifthenelse($3, $5, Some $7)) $2 }
+  | IF ext_attributes seq_expr THEN expr
+      { mkexp_attrs (Pexp_ifthenelse($3, $5, None)) $2 }
+  | WHILE ext_attributes seq_expr DO seq_expr DONE
+      { mkexp_attrs (Pexp_while($3, $5)) $2 }
+  | FOR ext_attributes val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
+      { mkexp_attrs(Pexp_for(mkrhs $3 3, $5, $7, $6, $9)) $2 }
   | expr COLONCOLON expr
       { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$1;$3])) (symbol_rloc()) }
   | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
@@ -1022,6 +1070,8 @@ expr:
       { mkinfix $1 "-." $3 }
   | expr STAR expr
       { mkinfix $1 "*" $3 }
+  | expr PERCENT expr
+      { mkinfix $1 "%" $3 }
   | expr EQUAL expr
       { mkinfix $1 "=" $3 }
   | expr LESS expr
@@ -1054,14 +1104,16 @@ expr:
       { bigarray_set $1 $4 $7 }
   | label LESSMINUS expr
       { mkexp(Pexp_setinstvar(mkrhs $1 1, $3)) }
-  | ASSERT simple_expr %prec below_SHARP
-      { mkassert $2 }
-  | LAZY simple_expr %prec below_SHARP
-      { mkexp (Pexp_lazy ($2)) }
-  | OBJECT class_structure END
-      { mkexp (Pexp_object($2)) }
-  | OBJECT class_structure error
+  | ASSERT ext_attributes simple_expr %prec below_SHARP
+      { mkexp_attrs (Pexp_assert $3) $2 }
+  | LAZY ext_attributes simple_expr %prec below_SHARP
+      { mkexp_attrs (Pexp_lazy $3) $2 }
+  | OBJECT ext_attributes class_structure END
+      { mkexp_attrs (Pexp_object $3) $2 }
+  | OBJECT ext_attributes class_structure error
       { unclosed "object" 1 "end" 3 }
+  | expr attribute
+      { Exp.attr $1 $2 }
 ;
 simple_expr:
     val_longident
@@ -1069,22 +1121,22 @@ simple_expr:
   | constant
       { mkexp(Pexp_constant $1) }
   | constr_longident %prec prec_constant_constructor
-      { mkexp(Pexp_construct(mkrhs $1 1, None, false)) }
+      { mkexp(Pexp_construct(mkrhs $1 1, None)) }
   | name_tag %prec prec_constant_constructor
       { mkexp(Pexp_variant($1, None)) }
   | LPAREN seq_expr RPAREN
       { reloc_exp $2 }
   | LPAREN seq_expr error
       { unclosed "(" 1 ")" 3 }
-  | BEGIN seq_expr END
-      { reloc_exp $2 }
-  | BEGIN END
-      { mkexp (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()),
-                               None, false)) }
-  | BEGIN seq_expr error
+  | BEGIN ext_attributes seq_expr END
+      { wrap_exp_attrs (reloc_exp $3) $2 (* check location *) }
+  | BEGIN ext_attributes END
+      { mkexp_attrs (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()),
+                               None)) $2 }
+  | BEGIN ext_attributes seq_expr error
       { unclosed "begin" 1 "end" 3 }
   | LPAREN seq_expr type_constraint RPAREN
-      { let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
+      { mkexp_constraint $2 $3 }
   | simple_expr DOT label_longident
       { mkexp(Pexp_field($1, mkrhs $3 3)) }
   | mod_longident DOT LPAREN seq_expr RPAREN
@@ -1106,15 +1158,15 @@ simple_expr:
   | simple_expr DOT LBRACE expr_comma_list error
       { unclosed "{" 3 "}" 5 }
   | LBRACE record_expr RBRACE
-      { let (exten, fields) = $2 in mkexp(Pexp_record(fields, exten)) }
+      { let (exten, fields) = $2 in mkexp (Pexp_record(fields, exten)) }
   | LBRACE record_expr error
       { unclosed "{" 1 "}" 3 }
   | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
-      { mkexp(Pexp_array(List.rev $2)) }
+      { mkexp (Pexp_array(List.rev $2)) }
   | LBRACKETBAR expr_semi_list opt_semi error
       { unclosed "[|" 1 "|]" 4 }
   | LBRACKETBAR BARRBRACKET
-      { mkexp(Pexp_array []) }
+      { mkexp (Pexp_array []) }
   | LBRACKET expr_semi_list opt_semi RBRACKET
       { reloc_exp (mktailexp (rhs_loc 4) (List.rev $2)) }
   | LBRACKET expr_semi_list opt_semi error
@@ -1123,23 +1175,25 @@ simple_expr:
       { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) }
   | BANG simple_expr
       { mkexp(Pexp_apply(mkoperator "!" 1, ["",$2])) }
-  | NEW class_longident
-      { mkexp(Pexp_new(mkrhs $2 2)) }
+  | NEW ext_attributes class_longident
+      { mkexp_attrs (Pexp_new(mkrhs $3 3)) $2 }
   | LBRACELESS field_expr_list opt_semi GREATERRBRACE
-      { mkexp(Pexp_override(List.rev $2)) }
+      { mkexp (Pexp_override(List.rev $2)) }
   | LBRACELESS field_expr_list opt_semi error
       { unclosed "{<" 1 ">}" 4 }
   | LBRACELESS GREATERRBRACE
-      { mkexp(Pexp_override []) }
+      { mkexp (Pexp_override [])}
   | simple_expr SHARP label
       { mkexp(Pexp_send($1, $3)) }
   | LPAREN MODULE module_expr RPAREN
       { mkexp (Pexp_pack $3) }
   | LPAREN MODULE module_expr COLON package_type RPAREN
       { mkexp (Pexp_constraint (ghexp (Pexp_pack $3),
-                                Some (ghtyp (Ptyp_package $5)), None)) }
+                                ghtyp (Ptyp_package $5))) }
   | LPAREN MODULE module_expr COLON error
       { unclosed "(" 1 ")" 5 }
+  | extension
+      { mkexp (Pexp_extension $1) }
 ;
 simple_labeled_expr_list:
     labeled_simple_expr
@@ -1176,6 +1230,9 @@ lident_list:
   | LIDENT lident_list                { $1 :: $2 }
 ;
 let_binding:
+    let_binding_ post_item_attributes { let (p, e) = $1 in Vb.mk ~attrs:$2 p e }
+;
+let_binding_:
     val_ident fun_binding
       { (mkpatvar $1 1, $2) }
   | val_ident COLON typevar_list DOT core_type EQUAL seq_expr
@@ -1192,31 +1249,37 @@ fun_binding:
     strict_binding
       { $1 }
   | type_constraint EQUAL seq_expr
-      { let (t, t') = $1 in ghexp(Pexp_constraint($3, t, t')) }
+      { mkexp_constraint $3 $1 }
 ;
 strict_binding:
     EQUAL seq_expr
       { $2 }
   | labeled_simple_pattern fun_binding
-      { let (l, o, p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
+      { let (l, o, p) = $1 in ghexp(Pexp_fun(l, o, p, $2)) }
   | LPAREN TYPE LIDENT RPAREN fun_binding
       { mkexp(Pexp_newtype($3, $5)) }
 ;
 match_cases:
-    pattern match_action                        { [$1, $2] }
-  | match_cases BAR pattern match_action        { ($3, $4) :: $1 }
+    match_case { [$1] }
+  | match_cases BAR match_case { $3 :: $1 }
+;
+match_case:
+    pattern MINUSGREATER seq_expr
+      { Exp.case $1 $3 }
+  | pattern WHEN seq_expr MINUSGREATER seq_expr
+      { Exp.case $1 ~guard:$3 $5 }
 ;
 fun_def:
-    match_action                                { $1 }
+    MINUSGREATER seq_expr                       { $2 }
+/* Cf #5939: we used to accept (fun p when e0 -> e) */
   | labeled_simple_pattern fun_def
-      { let (l,o,p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
+      {
+       let (l,o,p) = $1 in
+       ghexp(Pexp_fun(l, o, p, $2))
+      }
   | LPAREN TYPE LIDENT RPAREN fun_def
       { mkexp(Pexp_newtype($3, $5)) }
 ;
-match_action:
-    MINUSGREATER seq_expr                       { $2 }
-  | WHEN seq_expr MINUSGREATER seq_expr         { ghexp(Pexp_when($2, $4)) }
-;
 expr_comma_list:
     expr_comma_list COMMA expr                  { $3 :: $1 }
   | expr COMMA expr                             { [$3; $1] }
@@ -1266,7 +1329,7 @@ pattern:
   | pattern_comma_list  %prec below_COMMA
       { mkpat(Ppat_tuple(List.rev $1)) }
   | constr_longident pattern %prec prec_constr_appl
-      { mkpat(Ppat_construct(mkrhs $1 1, Some $2, false)) }
+      { mkpat(Ppat_construct(mkrhs $1 1, Some $2)) }
   | name_tag pattern %prec prec_constr_appl
       { mkpat(Ppat_variant($1, Some $2)) }
   | pattern COLONCOLON pattern
@@ -1283,6 +1346,8 @@ pattern:
       { expecting 3 "pattern" }
   | LAZY simple_pattern
       { mkpat(Ppat_lazy $2) }
+  | pattern attribute
+      { Pat.attr $1 $2 }
 ;
 simple_pattern:
     val_ident %prec below_EQUAL
@@ -1291,10 +1356,10 @@ simple_pattern:
       { mkpat(Ppat_any) }
   | signed_constant
       { mkpat(Ppat_constant $1) }
-  | CHAR DOTDOT CHAR
-      { mkrangepat $1 $3 }
+  | signed_constant DOTDOT signed_constant
+      { mkpat(Ppat_interval ($1, $3)) }
   | constr_longident
-      { mkpat(Ppat_construct(mkrhs $1 1, None, false)) }
+      { mkpat(Ppat_construct(mkrhs $1 1, None)) }
   | name_tag
       { mkpat(Ppat_variant($1, None)) }
   | SHARP type_longident
@@ -1330,6 +1395,8 @@ simple_pattern:
                               ghtyp(Ptyp_package $5))) }
   | LPAREN MODULE UIDENT COLON package_type error
       { unclosed "(" 1 ")" 6 }
+  | extension
+      { mkpat(Ppat_extension $1) }
 ;
 
 pattern_comma_list:
@@ -1358,8 +1425,8 @@ lbl_pattern:
 /* Primitive declarations */
 
 primitive_declaration:
-    STRING                                      { [$1] }
-  | STRING primitive_declaration                { $1 :: $2 }
+    STRING                                      { [fst $1] }
+  | STRING primitive_declaration                { fst $1 :: $2 }
 ;
 
 /* Type declarations */
@@ -1370,16 +1437,12 @@ type_declarations:
 ;
 
 type_declaration:
-    optional_type_parameters LIDENT type_kind constraints
-      { let (params, variance) = List.split $1 in
-        let (kind, private_flag, manifest) = $3 in
-        (mkrhs $2 2, {ptype_params = params;
-              ptype_cstrs = List.rev $4;
-              ptype_kind = kind;
-              ptype_private = private_flag;
-              ptype_manifest = manifest;
-              ptype_variance = variance;
-              ptype_loc = symbol_rloc() }) }
+    optional_type_parameters LIDENT type_kind constraints post_item_attributes
+      { let (kind, priv, manifest) = $3 in
+        Type.mk (mkrhs $2 2)
+          ~params:$1 ~cstrs:(List.rev $4)
+          ~kind ~priv ?manifest ~attrs:$5 ~loc:(symbol_rloc())
+       }
 ;
 constraints:
         constraints CONSTRAINT constrain        { $3 :: $1 }
@@ -1430,9 +1493,9 @@ type_parameter:
     type_variance QUOTE ident                   { mkrhs $3 3, $1 }
 ;
 type_variance:
-    /* empty */                                 { false, false }
-  | PLUS                                        { true, false }
-  | MINUS                                       { false, true }
+    /* empty */                                 { Invariant }
+  | PLUS                                        { Covariant }
+  | MINUS                                       { Contravariant }
 ;
 type_parameter_list:
     type_parameter                              { [$1] }
@@ -1443,23 +1506,26 @@ constructor_declarations:
   | constructor_declarations BAR constructor_declaration { $3 :: $1 }
 ;
 constructor_declaration:
-
-  | constr_ident generalized_constructor_arguments
-      { let arg_types,ret_type = $2 in
-        (mkrhs $1 1, arg_types,ret_type, symbol_rloc()) }
-;
-
-constructor_arguments:
-    /*empty*/                                   { [] }
-  | OF core_type_list                           { List.rev $2 }
+  | constr_ident attributes generalized_constructor_arguments
+      {
+       let args,res = $3 in
+       Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2
+      }
+;
+exception_declaration:
+  | constructor_declaration post_item_attributes
+      {
+        let cd = $1 in
+        {cd with pcd_attributes = cd.pcd_attributes @ $2}
+      }
 ;
-
 generalized_constructor_arguments:
     /*empty*/                                   { ([],None) }
   | OF core_type_list                           { (List.rev $2,None) }
   | COLON core_type_list MINUSGREATER simple_core_type
                                                 { (List.rev $2,Some $4) }
-  | COLON simple_core_type                      { ([],Some $2) }
+  | COLON simple_core_type
+                                                { ([],Some $2) }
 ;
 
 
@@ -1469,8 +1535,10 @@ label_declarations:
   | label_declarations SEMI label_declaration   { $3 :: $1 }
 ;
 label_declaration:
-    mutable_flag label COLON poly_type
-      { (mkrhs $2 2, $1, $4, symbol_rloc()) }
+    mutable_flag label attributes COLON poly_type
+      {
+       Type.field (mkrhs $2 2) $5 ~mut:$1 ~attrs:$3 ~loc:(symbol_rloc())
+      }
 ;
 
 /* "with" constraints (additional type equations over signature components) */
@@ -1481,31 +1549,26 @@ with_constraints:
 ;
 with_constraint:
     TYPE type_parameters label_longident with_type_binder core_type constraints
-      { let params, variance = List.split $2 in
-        (mkrhs $3 3,
-         Pwith_type {ptype_params = List.map (fun x -> Some x) params;
-                     ptype_cstrs = List.rev $6;
-                     ptype_kind = Ptype_abstract;
-                     ptype_manifest = Some $5;
-                     ptype_private = $4;
-                     ptype_variance = variance;
-                     ptype_loc = symbol_rloc()}) }
+      { Pwith_type
+          (mkrhs $3 3,
+           (Type.mk (mkrhs (Longident.last $3) 3)
+              ~params:(List.map (fun (x, v) -> Some x, v) $2)
+              ~cstrs:(List.rev $6)
+              ~manifest:$5
+              ~priv:$4
+              ~loc:(symbol_rloc()))) }
     /* used label_longident instead of type_longident to disallow
        functor applications in type path */
   | TYPE type_parameters label COLONEQUAL core_type
-      { let params, variance = List.split $2 in
-        (mkrhs (Lident $3) 3,
-         Pwith_typesubst { ptype_params = List.map (fun x -> Some x) params;
-                           ptype_cstrs = [];
-                           ptype_kind = Ptype_abstract;
-                           ptype_manifest = Some $5;
-                           ptype_private = Public;
-                           ptype_variance = variance;
-                           ptype_loc = symbol_rloc()}) }
+      { Pwith_typesubst
+          (Type.mk (mkrhs $3 3)
+             ~params:(List.map (fun (x, v) -> Some x, v) $2)
+             ~manifest:$5
+             ~loc:(symbol_rloc())) }
   | MODULE mod_longident EQUAL mod_ext_longident
-      { (mkrhs $2 2, Pwith_module (mkrhs $4 4)) }
+      { Pwith_module (mkrhs $2 2, mkrhs $4 4) }
   | MODULE UIDENT COLONEQUAL mod_ext_longident
-      { (mkrhs (Lident $2) 2, Pwith_modsubst (mkrhs $4 4)) }
+      { Pwith_modsubst (mkrhs $2 2, mkrhs $4 4) }
 ;
 with_type_binder:
     EQUAL          { Public }
@@ -1520,7 +1583,7 @@ typevar_list:
 ;
 poly_type:
         core_type
-          { mktyp(Ptyp_poly([], $1)) }
+          { $1 }
       | typevar_list DOT core_type
           { mktyp(Ptyp_poly(List.rev $1, $3)) }
 ;
@@ -1551,7 +1614,17 @@ simple_core_type:
       { $1 }
   | LPAREN core_type_comma_list RPAREN %prec below_SHARP
       { match $2 with [sty] -> sty | _ -> raise Parse_error }
+  | simple_core_type attribute
+      { Typ.attr $1 $2 }
+;
+
+simple_core_type_no_attr:
+    simple_core_type2  %prec below_SHARP
+      { $1 }
+  | LPAREN core_type_comma_list RPAREN %prec below_SHARP
+      { match $2 with [sty] -> sty | _ -> raise Parse_error }
 ;
+
 simple_core_type2:
     QUOTE ident
       { mktyp(Ptyp_var $2) }
@@ -1564,35 +1637,37 @@ simple_core_type2:
   | LPAREN core_type_comma_list RPAREN type_longident
       { mktyp(Ptyp_constr(mkrhs $4 4, List.rev $2)) }
   | LESS meth_list GREATER
-      { mktyp(Ptyp_object $2) }
+      { let (f, c) = $2 in mktyp(Ptyp_object (f, c)) }
   | LESS GREATER
-      { mktyp(Ptyp_object []) }
-  | SHARP class_longident opt_present
-      { mktyp(Ptyp_class(mkrhs $2 2, [], $3)) }
-  | simple_core_type2 SHARP class_longident opt_present
-      { mktyp(Ptyp_class(mkrhs $3 3, [$1], $4)) }
-  | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
-      { mktyp(Ptyp_class(mkrhs $5 5, List.rev $2, $6)) }
+      { mktyp(Ptyp_object ([], Closed)) }
+  | SHARP class_longident
+      { mktyp(Ptyp_class(mkrhs $2 2, [])) }
+  | simple_core_type2 SHARP class_longident
+      { mktyp(Ptyp_class(mkrhs $3 3, [$1])) }
+  | LPAREN core_type_comma_list RPAREN SHARP class_longident
+      { mktyp(Ptyp_class(mkrhs $5 5, List.rev $2)) }
   | LBRACKET tag_field RBRACKET
-      { mktyp(Ptyp_variant([$2], true, None)) }
+      { mktyp(Ptyp_variant([$2], Closed, None)) }
 /* PR#3835: this is not LR(1), would need lookahead=2
   | LBRACKET simple_core_type RBRACKET
-      { mktyp(Ptyp_variant([$2], true, None)) }
+      { mktyp(Ptyp_variant([$2], Closed, None)) }
 */
   | LBRACKET BAR row_field_list RBRACKET
-      { mktyp(Ptyp_variant(List.rev $3, true, None)) }
+      { mktyp(Ptyp_variant(List.rev $3, Closed, None)) }
   | LBRACKET row_field BAR row_field_list RBRACKET
-      { mktyp(Ptyp_variant($2 :: List.rev $4, true, None)) }
+      { mktyp(Ptyp_variant($2 :: List.rev $4, Closed, None)) }
   | LBRACKETGREATER opt_bar row_field_list RBRACKET
-      { mktyp(Ptyp_variant(List.rev $3, false, None)) }
+      { mktyp(Ptyp_variant(List.rev $3, Open, None)) }
   | LBRACKETGREATER RBRACKET
-      { mktyp(Ptyp_variant([], false, None)) }
+      { mktyp(Ptyp_variant([], Open, None)) }
   | LBRACKETLESS opt_bar row_field_list RBRACKET
-      { mktyp(Ptyp_variant(List.rev $3, true, Some [])) }
+      { mktyp(Ptyp_variant(List.rev $3, Closed, Some [])) }
   | LBRACKETLESS opt_bar row_field_list GREATER name_tag_list RBRACKET
-      { mktyp(Ptyp_variant(List.rev $3, true, Some (List.rev $5))) }
+      { mktyp(Ptyp_variant(List.rev $3, Closed, Some (List.rev $5))) }
   | LPAREN MODULE package_type RPAREN
       { mktyp(Ptyp_package $3) }
+  | extension
+      { mktyp (Ptyp_extension $1) }
 ;
 package_type:
     mty_longident { (mkrhs $1 1, []) }
@@ -1627,34 +1702,40 @@ amper_type_list:
     core_type                                   { [$1] }
   | amper_type_list AMPERSAND core_type         { $3 :: $1 }
 ;
-opt_present:
-    LBRACKETGREATER name_tag_list RBRACKET      { List.rev $2 }
-  | /* empty */                                 { [] }
-;
 name_tag_list:
     name_tag                                    { [$1] }
   | name_tag_list name_tag                      { $2 :: $1 }
 ;
 simple_core_type_or_tuple:
-    simple_core_type                            { $1 }
+    simple_core_type %prec below_LBRACKETAT  { $1 }
   | simple_core_type STAR core_type_list
       { mktyp(Ptyp_tuple($1 :: List.rev $3)) }
 ;
+simple_core_type_or_tuple_no_attr:
+    simple_core_type_no_attr
+      { $1 }
+  | simple_core_type_no_attr STAR core_type_list_no_attr
+      { mktyp(Ptyp_tuple($1 :: List.rev $3)) }
+;
 core_type_comma_list:
     core_type                                   { [$1] }
   | core_type_comma_list COMMA core_type        { $3 :: $1 }
 ;
 core_type_list:
-    simple_core_type                            { [$1] }
+    simple_core_type %prec below_LBRACKETAT  { [$1] }
   | core_type_list STAR simple_core_type        { $3 :: $1 }
 ;
+core_type_list_no_attr:
+    simple_core_type_no_attr                     { [$1] }
+  | core_type_list STAR simple_core_type_no_attr { $3 :: $1 }
+;
 meth_list:
-    field SEMI meth_list                        { $1 :: $3 }
-  | field opt_semi                              { [$1] }
-  | DOTDOT                                      { [mkfield Pfield_var] }
+    field SEMI meth_list                        { let (f, c) = $3 in ($1 :: f, c) }
+  | field opt_semi                              { [$1], Closed }
+  | DOTDOT                                      { [], Open }
 ;
 field:
-    label COLON poly_type                       { mkfield(Pfield($1, $3)) }
+    label COLON poly_type /* ok */              { ($1, $3) }
 ;
 label:
     LIDENT                                      { $1 }
@@ -1665,7 +1746,7 @@ label:
 constant:
     INT                                         { Const_int $1 }
   | CHAR                                        { Const_char $1 }
-  | STRING                                      { Const_string $1 }
+  | STRING                                      { let (s, d) = $1 in Const_string (s, d) }
   | FLOAT                                       { Const_float $1 }
   | INT32                                       { Const_int32 $1 }
   | INT64                                       { Const_int64 $1 }
@@ -1719,6 +1800,7 @@ operator:
   | AMPERSAND                                   { "&" }
   | AMPERAMPER                                  { "&&" }
   | COLONEQUAL                                  { ":=" }
+  | PERCENT                                     { "%" }
 ;
 constr_ident:
     UIDENT                                      { $1 }
@@ -1770,21 +1852,12 @@ class_longident:
     LIDENT                                      { Lident $1 }
   | mod_longident DOT LIDENT                    { Ldot($1, $3) }
 ;
-any_longident:
-    val_ident                                   { Lident $1 }
-  | mod_ext_longident DOT val_ident             { Ldot ($1, $3) }
-  | mod_ext_longident                           { $1 }
-  | LBRACKET RBRACKET                           { Lident "[]" }
-  | LPAREN RPAREN                               { Lident "()" }
-  | FALSE                                       { Lident "false" }
-  | TRUE                                        { Lident "true" }
-;
 
 /* Toplevel directives */
 
 toplevel_directive:
     SHARP ident                 { Ptop_dir($2, Pdir_none) }
-  | SHARP ident STRING          { Ptop_dir($2, Pdir_string $3) }
+  | SHARP ident STRING          { Ptop_dir($2, Pdir_string (fst $3)) }
   | SHARP ident INT             { Ptop_dir($2, Pdir_int $3) }
   | SHARP ident val_longident   { Ptop_dir($2, Pdir_ident $3) }
   | SHARP ident FALSE           { Ptop_dir($2, Pdir_bool false) }
@@ -1816,6 +1889,13 @@ virtual_flag:
     /* empty */                                 { Concrete }
   | VIRTUAL                                     { Virtual }
 ;
+private_virtual_flags:
+    /* empty */  { Public, Concrete }
+  | PRIVATE { Private, Concrete }
+  | VIRTUAL { Public, Virtual }
+  | PRIVATE VIRTUAL { Private, Virtual }
+  | VIRTUAL PRIVATE { Private, Virtual }
+;
 override_flag:
     /* empty */                                 { Fresh }
   | BANG                                        { Override }
@@ -1836,4 +1916,96 @@ additive:
   | PLUS                                        { "+" }
   | PLUSDOT                                     { "+." }
 ;
+
+/* Attributes and extensions */
+
+single_attr_id:
+    LIDENT { $1 }
+  | UIDENT { $1 }
+  | AND { "and" }
+  | AS { "as" }
+  | ASSERT { "assert" }
+  | BEGIN { "begin" }
+  | CLASS { "class" }
+  | CONSTRAINT { "constraint" }
+  | DO { "do" }
+  | DONE { "done" }
+  | DOWNTO { "downto" }
+  | ELSE { "else" }
+  | END { "end" }
+  | EXCEPTION { "exception" }
+  | EXTERNAL { "external" }
+  | FALSE { "false" }
+  | FOR { "for" }
+  | FUN { "fun" }
+  | FUNCTION { "function" }
+  | FUNCTOR { "functor" }
+  | IF { "if" }
+  | IN { "in" }
+  | INCLUDE { "include" }
+  | INHERIT { "inherit" }
+  | INITIALIZER { "initializer" }
+  | LAZY { "lazy" }
+  | LET { "let" }
+  | MATCH { "match" }
+  | METHOD { "method" }
+  | MODULE { "module" }
+  | MUTABLE { "mutable" }
+  | NEW { "new" }
+  | OBJECT { "object" }
+  | OF { "of" }
+  | OPEN { "open" }
+  | OR { "or" }
+  | PRIVATE { "private" }
+  | REC { "rec" }
+  | SIG { "sig" }
+  | STRUCT { "struct" }
+  | THEN { "then" }
+  | TO { "to" }
+  | TRUE { "true" }
+  | TRY { "try" }
+  | TYPE { "type" }
+  | VAL { "val" }
+  | VIRTUAL { "virtual" }
+  | WHEN { "when" }
+  | WHILE { "while" }
+  | WITH { "with" }
+/* mod/land/lor/lxor/lsl/lsr/asr are not supported for now */
+;
+
+attr_id:
+    single_attr_id { mkloc $1 (symbol_rloc()) }
+  | single_attr_id DOT attr_id { mkloc ($1 ^ "." ^ $3.txt) (symbol_rloc())}
+;
+attribute:
+  LBRACKETAT attr_id payload RBRACKET { ($2, $3) }
+;
+post_item_attribute:
+  LBRACKETATAT attr_id payload RBRACKET { ($2, $3) }
+;
+post_item_attributes:
+    /* empty */  { [] }
+  | post_item_attribute post_item_attributes { $1 :: $2 }
+;
+attributes:
+    /* empty */{ [] }
+  | attribute attributes { $1 :: $2 }
+;
+ext_attributes:
+    /* empty */  { None, [] }
+  | attribute attributes { None, $1 :: $2 }
+  | PERCENT attr_id attributes { Some $2, $3 }
+;
+extension:
+  LBRACKETPERCENT attr_id payload RBRACKET { ($2, $3) }
+;
+item_extension:
+  LBRACKETPERCENTPERCENT attr_id payload RBRACKET { ($2, $3) }
+;
+payload:
+    structure { PStr $1 }
+  | COLON core_type { PTyp $2 }
+  | QUESTION pattern { PPat ($2, None) }
+  | QUESTION pattern WHEN seq_expr { PPat ($2, Some $4) }
+;
 %%
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index ce6ac362d..762b2a6d9 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -10,172 +10,439 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* Abstract syntax tree produced by parsing *)
+(** Abstract syntax tree produced by parsing *)
 
 open Asttypes
 
-(* Type expressions for the core language *)
+(** {2 Extension points} *)
 
-type core_type =
-  { ptyp_desc: core_type_desc;
-    ptyp_loc: Location.t }
+type attribute = string loc * payload
+      (* [@id STRUCTURE]
+         [@@id STRUCTURE]
+       *)
+
+and extension = string loc * payload
+      (* [%id STRUCTURE]
+         [%%id STRUCTURE]
+       *)
+
+and attributes = attribute list
+
+and payload =
+  | PStr of structure
+  | PTyp of core_type  (* : T *)
+  | PPat of pattern * expression option  (* : P  or  : P when E *)
+
+(** {2 Core language} *)
+
+(* Type expressions *)
+
+and core_type =
+    {
+     ptyp_desc: core_type_desc;
+     ptyp_loc: Location.t;
+     ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and core_type_desc =
-    Ptyp_any
+  | Ptyp_any
+        (*  _ *)
   | Ptyp_var of string
+        (* 'a *)
   | Ptyp_arrow of label * core_type * core_type
+        (* T1 -> T2       (label = "")
+           ~l:T1 -> T2    (label = "l")
+           ?l:T1 -> T2    (label = "?l")
+         *)
   | Ptyp_tuple of core_type list
+        (* T1 * ... * Tn   (n >= 2) *)
   | Ptyp_constr of Longident.t loc * core_type list
-  | Ptyp_object of core_field_type list
-  | Ptyp_class of Longident.t loc * core_type list * label list
+        (* tconstr
+           T tconstr
+           (T1, ..., Tn) tconstr
+         *)
+  | Ptyp_object of (string * core_type) list * closed_flag
+        (* < l1:T1; ...; ln:Tn >     (flag = Closed)
+           < l1:T1; ...; ln:Tn; .. > (flag = Open)
+         *)
+  | Ptyp_class of Longident.t loc * core_type list
+        (* #tconstr
+           T #tconstr
+           (T1, ..., Tn) #tconstr
+         *)
   | Ptyp_alias of core_type * string
-  | Ptyp_variant of row_field list * bool * label list option
+        (* T as 'a *)
+  | Ptyp_variant of row_field list * closed_flag * label list option
+        (* [ `A|`B ]         (flag = Closed; labels = None)
+           [> `A|`B ]        (flag = Open;   labels = None)
+           [< `A|`B ]        (flag = Closed; labels = Some [])
+           [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"])
+         *)
   | Ptyp_poly of string list * core_type
-  | Ptyp_package of package_type
+        (* 'a1 ... 'an. T
 
+           Can only appear in the following context:
 
-and package_type = Longident.t loc * (Longident.t loc * core_type) list
+           - As the core_type of a Ppat_constraint node corresponding
+             to a constraint on a let-binding: let x : 'a1 ... 'an. T
+             = e ...
 
-and core_field_type =
-  { pfield_desc: core_field_desc;
-    pfield_loc: Location.t }
+           - Under Cfk_virtual for methods (not values).
 
-and core_field_desc =
-    Pfield of string * core_type
-  | Pfield_var
+           - As the core_type of a Pctf_method node.
 
-and row_field =
-    Rtag of label * bool * core_type list
-  | Rinherit of core_type
+           - As the core_type of a Pexp_poly node.
 
-(* Type expressions for the class language *)
+           - As the pld_type field of a label_declaration.
+
+           - As a core_type of a Ptyp_object node.
+         *)
+
+  | Ptyp_package of package_type
+        (* (module S) *)
+  | Ptyp_extension of extension
+        (* [%id] *)
+
+and package_type = Longident.t loc * (Longident.t loc * core_type) list
+      (*
+        (module S)
+        (module S with type t1 = T1 and ... and tn = Tn)
+       *)
 
-type 'a class_infos =
-  { pci_virt: virtual_flag;
-    pci_params: string loc list * Location.t;
-    pci_name: string loc;
-    pci_expr: 'a;
-    pci_variance: (bool * bool) list;
-    pci_loc: Location.t }
+and row_field =
+  | Rtag of label * bool * core_type list
+        (* [`A]                   ( true,  [] )
+           [`A of T]              ( false, [T] )
+           [`A of T1 & .. & Tn]   ( false, [T1;...Tn] )
+           [`A of & T1 & .. & Tn] ( true,  [T1;...Tn] )
+         *)
+  | Rinherit of core_type
+        (* [ T ] *)
 
-(* Value expressions for the core language *)
+(* Patterns *)
 
-type pattern =
-  { ppat_desc: pattern_desc;
-    ppat_loc: Location.t }
+and pattern =
+    {
+     ppat_desc: pattern_desc;
+     ppat_loc: Location.t;
+     ppat_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and pattern_desc =
-    Ppat_any
+  | Ppat_any
+        (* _ *)
   | Ppat_var of string loc
+        (* x *)
   | Ppat_alias of pattern * string loc
+        (* P as 'a *)
   | Ppat_constant of constant
+        (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Ppat_interval of constant * constant
+        (* 'a'..'z'
+
+           Other forms of interval are recognized by the parser
+           but rejected by the type-checker. *)
   | Ppat_tuple of pattern list
-  | Ppat_construct of Longident.t loc * pattern option * bool
+        (* (P1, ..., Pn)   (n >= 2) *)
+  | Ppat_construct of Longident.t loc * pattern option
+        (* C                None
+           C P              Some P
+           C (P1, ..., Pn)  Some (Ppat_tuple [P1; ...; Pn])
+         *)
   | Ppat_variant of label * pattern option
+        (* `A             (None)
+           `A P           (Some P)
+         *)
   | Ppat_record of (Longident.t loc * pattern) list * closed_flag
+        (* { l1=P1; ...; ln=Pn }     (flag = Closed)
+           { l1=P1; ...; ln=Pn; _}   (flag = Open)
+         *)
   | Ppat_array of pattern list
+        (* [| P1; ...; Pn |] *)
   | Ppat_or of pattern * pattern
+        (* P1 | P2 *)
   | Ppat_constraint of pattern * core_type
+        (* (P : T) *)
   | Ppat_type of Longident.t loc
+        (* #tconst *)
   | Ppat_lazy of pattern
+        (* lazy P *)
   | Ppat_unpack of string loc
-
-type expression =
-  { pexp_desc: expression_desc;
-    pexp_loc: Location.t }
+        (* (module P)
+           Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package)
+         *)
+  | Ppat_extension of extension
+        (* [%id] *)
+
+(* Value expressions *)
+
+and expression =
+    {
+     pexp_desc: expression_desc;
+     pexp_loc: Location.t;
+     pexp_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and expression_desc =
-    Pexp_ident of Longident.t loc
+  | Pexp_ident of Longident.t loc
+        (* x
+           M.x
+         *)
   | Pexp_constant of constant
-  | Pexp_let of rec_flag * (pattern * expression) list * expression
-  | Pexp_function of label * expression option * (pattern * expression) list
+        (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Pexp_let of rec_flag * value_binding list * expression
+        (* let P1 = E1 and ... and Pn = EN in E       (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN in E   (flag = Recursive)
+         *)
+  | Pexp_function of case list
+        (* function P1 -> E1 | ... | Pn -> En *)
+  | Pexp_fun of label * expression option * pattern * expression
+        (* fun P -> E1                          (lab = "", None)
+           fun ~l:P -> E1                       (lab = "l", None)
+           fun ?l:P -> E1                       (lab = "?l", None)
+           fun ?l:(P = E0) -> E1                (lab = "?l", Some E0)
+
+           Notes:
+           - If E0 is provided, lab must start with '?'.
+           - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
+           - "let f P = E" is represented using Pexp_fun.
+         *)
   | Pexp_apply of expression * (label * expression) list
-  | Pexp_match of expression * (pattern * expression) list
-  | Pexp_try of expression * (pattern * expression) list
+        (* E0 ~l1:E1 ... ~ln:En
+           li can be empty (non labeled argument) or start with '?'
+           (optional argument).
+         *)
+  | Pexp_match of expression * case list
+        (* match E0 with P1 -> E1 | ... | Pn -> En *)
+  | Pexp_try of expression * case list
+        (* try E0 with P1 -> E1 | ... | Pn -> En *)
   | Pexp_tuple of expression list
-  | Pexp_construct of Longident.t loc * expression option * bool
+        (* (E1, ..., En)   (n >= 2) *)
+  | Pexp_construct of Longident.t loc * expression option
+        (* C                None
+           C E              Some E
+           C (E1, ..., En)  Some (Pexp_tuple[E1;...;En])
+        *)
   | Pexp_variant of label * expression option
+        (* `A             (None)
+           `A E           (Some E)
+         *)
   | Pexp_record of (Longident.t loc * expression) list * expression option
+        (* { l1=P1; ...; ln=Pn }     (None)
+           { E0 with l1=P1; ...; ln=Pn }   (Some E0)
+         *)
   | Pexp_field of expression * Longident.t loc
+        (* E.l *)
   | Pexp_setfield of expression * Longident.t loc * expression
+        (* E1.l <- E2 *)
   | Pexp_array of expression list
+        (* [| E1; ...; En |] *)
   | Pexp_ifthenelse of expression * expression * expression option
+        (* if E1 then E2 else E3 *)
   | Pexp_sequence of expression * expression
+        (* E1; E2 *)
   | Pexp_while of expression * expression
+        (* while E1 do E2 done *)
   | Pexp_for of
       string loc *  expression * expression * direction_flag * expression
-  | Pexp_constraint of expression * core_type option * core_type option
-  | Pexp_when of expression * expression
+        (* for i = E1 to E2 do E3 done      (flag = Upto)
+           for i = E1 downto E2 do E3 done  (flag = Downto)
+         *)
+  | Pexp_constraint of expression * core_type
+        (* (E : T) *)
+  | Pexp_coerce of expression * core_type option * core_type
+        (* (E :> T)        (None, T)
+           (E : T0 :> T)   (Some T0, T)
+         *)
   | Pexp_send of expression * string
+        (*  E # m *)
   | Pexp_new of Longident.t loc
+        (* new M.c *)
   | Pexp_setinstvar of string loc * expression
+        (* x <- 2 *)
   | Pexp_override of (string loc * expression) list
+        (* {< x1 = E1; ...; Xn = En >} *)
   | Pexp_letmodule of string loc * module_expr * expression
+        (* let module M = ME in E *)
   | Pexp_assert of expression
-  | Pexp_assertfalse
+        (* assert E
+           Note: "assert false" is treated in a special way by the type-checker. *)
   | Pexp_lazy of expression
+        (* lazy E *)
   | Pexp_poly of expression * core_type option
+        (* Used for method bodies.
+
+           Can only be used as the expression under Cfk_concrete
+           for methods (not values). *)
   | Pexp_object of class_structure
+        (* object ... end *)
   | Pexp_newtype of string * expression
+        (* fun (type t) -> E *)
   | Pexp_pack of module_expr
+        (* (module ME)
+
+           (module ME : S) is represented as
+           Pexp_constraint(Pexp_pack, Ptyp_package S) *)
   | Pexp_open of override_flag * Longident.t loc * expression
+        (* let open M in E *)
+  | Pexp_extension of extension
+        (* [%id] *)
+
+and case =   (* (P -> E) or (P when E0 -> E) *)
+    {
+     pc_lhs: pattern;
+     pc_guard: expression option;
+     pc_rhs: expression;
+    }
 
 (* Value descriptions *)
 
 and value_description =
-  { pval_type: core_type;
-    pval_prim: string list;
-    pval_loc: Location.t
+    {
+     pval_name: string loc;
+     pval_type: core_type;
+     pval_prim: string list;
+     pval_attributes: attributes;  (* ... [@@id1] [@@id2] *)
+     pval_loc: Location.t;
     }
 
+(*
+  val x: T                            (prim = [])
+  external x: T = "s1" ... "sn"       (prim = ["s1";..."sn"])
+
+  Note: when used under Pstr_primitive, prim cannot be empty
+*)
+
 (* Type declarations *)
 
 and type_declaration =
-  { ptype_params: string loc option list;
-    ptype_cstrs: (core_type * core_type * Location.t) list;
-    ptype_kind: type_kind;
-    ptype_private: private_flag;
-    ptype_manifest: core_type option;
-    ptype_variance: (bool * bool) list;
-    ptype_loc: Location.t }
+    {
+     ptype_name: string loc;
+     ptype_params: (string loc option * variance) list;
+           (* ('a1,...'an) t; None represents  _*)
+     ptype_cstrs: (core_type * core_type * Location.t) list;
+           (* ... constraint T1=T1'  ... constraint Tn=Tn' *)
+     ptype_kind: type_kind;
+     ptype_private: private_flag;   (* = private ... *)
+     ptype_manifest: core_type option;  (* = T *)
+     ptype_attributes: attributes;   (* ... [@@id1] [@@id2] *)
+     ptype_loc: Location.t;
+    }
+
+(*
+  type t                     (abstract, no manifest)
+  type t = T0                (abstract, manifest=T0)
+  type t = C of T | ...      (variant,  no manifest)
+  type t = T0 = C of T | ... (variant,  manifest=T0)
+  type t = {l: T; ...}       (record,   no manifest)
+  type t = T0 = {l : T; ...} (record,   manifest=T0)
+*)
 
 and type_kind =
-    Ptype_abstract
-  | Ptype_variant of
-      (string loc * core_type list * core_type option * Location.t) list
-  | Ptype_record of
-      (string loc * mutable_flag * core_type * Location.t) list
+  | Ptype_abstract
+  | Ptype_variant of constructor_declaration list
+  | Ptype_record of label_declaration list
+
+and label_declaration =
+    {
+     pld_name: string loc;
+     pld_mutable: mutable_flag;
+     pld_type: core_type;
+     pld_loc: Location.t;
+     pld_attributes: attributes; (* l [@id1] [@id2] : T *)
+    }
+
+(*  { ...; l: T; ... }            (mutable=Immutable)
+    { ...; mutable l: T; ... }    (mutable=Mutable)
 
-and exception_declaration = core_type list
+    Note: T can be a Pexp_poly.
+*)
+
+and constructor_declaration =
+    {
+     pcd_name: string loc;
+     pcd_args: core_type list;
+     pcd_res: core_type option;
+     pcd_loc: Location.t;
+     pcd_attributes: attributes; (* C [@id1] [@id2] of ... *)
+    }
+(*
+  | C of T1 * ... * Tn     (res = None)
+  | C: T0                  (args = [], res = Some T0)
+  | C: T1 * ... * Tn -> T0 (res = Some T0)
+*)
+
+(** {2 Class language} *)
 
 (* Type expressions for the class language *)
 
 and class_type =
-  { pcty_desc: class_type_desc;
-    pcty_loc: Location.t }
+    {
+     pcty_desc: class_type_desc;
+     pcty_loc: Location.t;
+     pcty_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and class_type_desc =
-    Pcty_constr of Longident.t loc * core_type list
+  | Pcty_constr of Longident.t loc * core_type list
+        (* c
+           ['a1, ..., 'an] c *)
   | Pcty_signature of class_signature
-  | Pcty_fun of label * core_type * class_type
-
-and class_signature = {
-    pcsig_self: core_type;
-    pcsig_fields: class_type_field list;
-    pcsig_loc: Location.t;
-  }
-
-and class_type_field = {
-    pctf_desc: class_type_field_desc;
-    pctf_loc: Location.t;
-  }
+        (* object ... end *)
+  | Pcty_arrow of label * core_type * class_type
+        (* T -> CT       (label = "")
+           ~l:T -> CT    (label = "l")
+           ?l:T -> CT    (label = "?l")
+         *)
+  | Pcty_extension of extension
+        (* [%id] *)
+
+and class_signature =
+    {
+     pcsig_self: core_type;
+     pcsig_fields: class_type_field list;
+    }
+(* object('selfpat) ... end
+   object ... end             (self = Ptyp_any)
+ *)
+
+and class_type_field =
+    {
+     pctf_desc: class_type_field_desc;
+     pctf_loc: Location.t;
+     pctf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+    }
 
 and class_type_field_desc =
-    Pctf_inher of class_type
+  | Pctf_inherit of class_type
+        (* inherit CT *)
   | Pctf_val of (string * mutable_flag * virtual_flag * core_type)
-  | Pctf_virt  of (string * private_flag * core_type)
-  | Pctf_meth  of (string * private_flag * core_type)
-  | Pctf_cstr  of (core_type * core_type)
+        (* val x: T *)
+  | Pctf_method  of (string * private_flag * virtual_flag * core_type)
+        (* method x: T
+
+           Note: T can be a Pexp_poly.
+         *)
+  | Pctf_constraint  of (core_type * core_type)
+        (* constraint T1 = T2 *)
+  | Pctf_extension of extension
+        (* [%%id] *)
+
+and 'a class_infos =
+    {
+     pci_virt: virtual_flag;
+     pci_params: (string loc * variance) list;
+     pci_name: string loc;
+     pci_expr: 'a;
+     pci_loc: Location.t;
+     pci_attributes: attributes;  (* ... [@@id1] [@@id2] *)
+    }
+(* class c = ...
+   class ['a1,...,'an] c = ...
+   class virtual c = ...
+
+   Also used for "class type" declaration.
+*)
 
 and class_description = class_type class_infos
 
@@ -184,122 +451,272 @@ and class_type_declaration = class_type class_infos
 (* Value expressions for the class language *)
 
 and class_expr =
-  { pcl_desc: class_expr_desc;
-    pcl_loc: Location.t }
+    {
+     pcl_desc: class_expr_desc;
+     pcl_loc: Location.t;
+     pcl_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and class_expr_desc =
-    Pcl_constr of Longident.t loc * core_type list
+  | Pcl_constr of Longident.t loc * core_type list
+        (* c
+           ['a1, ..., 'an] c *)
   | Pcl_structure of class_structure
+        (* object ... end *)
   | Pcl_fun of label * expression option * pattern * class_expr
+        (* fun P -> CE                          (lab = "", None)
+           fun ~l:P -> CE                       (lab = "l", None)
+           fun ?l:P -> CE                       (lab = "?l", None)
+           fun ?l:(P = E0) -> CE                (lab = "?l", Some E0)
+         *)
   | Pcl_apply of class_expr * (label * expression) list
-  | Pcl_let of rec_flag * (pattern * expression) list * class_expr
+        (* CE ~l1:E1 ... ~ln:En
+           li can be empty (non labeled argument) or start with '?'
+           (optional argument).
+         *)
+  | Pcl_let of rec_flag * value_binding list * class_expr
+        (* let P1 = E1 and ... and Pn = EN in CE      (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN in CE  (flag = Recursive)
+         *)
   | Pcl_constraint of class_expr * class_type
-
-and class_structure = {
-    pcstr_pat: pattern;
-    pcstr_fields: class_field list;
-  }
-
-and class_field = {
-    pcf_desc: class_field_desc;
-    pcf_loc: Location.t;
-  }
+        (* (CE : CT) *)
+  | Pcl_extension of extension
+        (* [%id] *)
+
+and class_structure =
+    {
+     pcstr_self: pattern;
+     pcstr_fields: class_field list;
+    }
+(* object(selfpat) ... end
+   object ... end           (self = Ppat_any)
+ *)
+
+and class_field =
+    {
+     pcf_desc: class_field_desc;
+     pcf_loc: Location.t;
+     pcf_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and class_field_desc =
-    Pcf_inher of override_flag * class_expr * string option
-  | Pcf_valvirt of (string loc * mutable_flag * core_type)
-  | Pcf_val of (string loc * mutable_flag * override_flag * expression)
-  | Pcf_virt of (string loc * private_flag * core_type)
-  | Pcf_meth of (string loc * private_flag * override_flag * expression)
-  | Pcf_constr of (core_type * core_type)
-  | Pcf_init of expression
+  | Pcf_inherit of override_flag * class_expr * string option
+        (* inherit CE
+           inherit CE as x
+           inherit! CE
+           inherit! CE as x
+         *)
+  | Pcf_val of (string loc * mutable_flag * class_field_kind)
+        (* val x = E
+           val virtual x: T
+         *)
+  | Pcf_method of (string loc * private_flag * class_field_kind)
+        (* method x = E            (E can be a Pexp_poly)
+           method virtual x: T     (T can be a Ptyp_poly)
+         *)
+  | Pcf_constraint of (core_type * core_type)
+        (* constraint T1 = T2 *)
+  | Pcf_initializer of expression
+        (* initializer E *)
+  | Pcf_extension of extension
+        (* [%id] *)
+
+and class_field_kind =
+  | Cfk_virtual of core_type
+  | Cfk_concrete of override_flag * expression
 
 and class_declaration = class_expr class_infos
 
+(** {2 Module language} *)
+
 (* Type expressions for the module language *)
 
 and module_type =
-  { pmty_desc: module_type_desc;
-    pmty_loc: Location.t }
+    {
+     pmty_desc: module_type_desc;
+     pmty_loc: Location.t;
+     pmty_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and module_type_desc =
-    Pmty_ident of Longident.t loc
+  | Pmty_ident of Longident.t loc
+        (* S *)
   | Pmty_signature of signature
+        (* sig ... end *)
   | Pmty_functor of string loc * module_type * module_type
-  | Pmty_with of module_type * (Longident.t loc * with_constraint) list
+        (* functor(X : MT1) -> MT2 *)
+  | Pmty_with of module_type * with_constraint list
+        (* MT with ... *)
   | Pmty_typeof of module_expr
+        (* module type of ME *)
+  | Pmty_extension of extension
+        (* [%id] *)
 
 and signature = signature_item list
 
 and signature_item =
-  { psig_desc: signature_item_desc;
-    psig_loc: Location.t }
+    {
+     psig_desc: signature_item_desc;
+     psig_loc: Location.t;
+    }
 
 and signature_item_desc =
-    Psig_value of string loc * value_description
-  | Psig_type of (string loc * type_declaration) list
-  | Psig_exception of string loc * exception_declaration
-  | Psig_module of string loc * module_type
-  | Psig_recmodule of (string loc * module_type) list
-  | Psig_modtype of string loc * modtype_declaration
-  | Psig_open of override_flag * Longident.t loc
-  | Psig_include of module_type
+  | Psig_value of value_description
+        (*
+          val x: T
+          external x: T = "s1" ... "sn"
+         *)
+  | Psig_type of type_declaration list
+        (* type t1 = ... and ... and tn = ... *)
+  | Psig_exception of constructor_declaration
+        (* exception C of T *)
+  | Psig_module of module_declaration
+        (* module X : MT *)
+  | Psig_recmodule of module_declaration list
+        (* module rec X1 : MT1 and ... and Xn : MTn *)
+  | Psig_modtype of module_type_declaration
+        (* module type S = MT
+           module type S *)
+  | Psig_open of override_flag * Longident.t loc * attributes
+        (* open X *)
+  | Psig_include of module_type * attributes
+        (* include MT *)
   | Psig_class of class_description list
+        (* class c1 : ... and ... and cn : ... *)
   | Psig_class_type of class_type_declaration list
+        (* class type ct1 = ... and ... and ctn = ... *)
+  | Psig_attribute of attribute
+        (* [@@id]
+           (not attached to another item, i.e. after ";;" or at the beginning
+           of the signature) *)
+  | Psig_extension of extension * attributes
+        (* [%%id] *)
+
+and module_declaration =
+    {
+     pmd_name: string loc;
+     pmd_type: module_type;
+     pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+    }
+(* S : MT *)
 
-and modtype_declaration =
-    Pmodtype_abstract
-  | Pmodtype_manifest of module_type
+and module_type_declaration =
+    {
+     pmtd_name: string loc;
+     pmtd_type: module_type option;
+     pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+    }
+(* S = MT
+   S       (abstract module type declaration, pmtd_type = None)
+*)
 
 and with_constraint =
-    Pwith_type of type_declaration
-  | Pwith_module of Longident.t loc
+  | Pwith_type of Longident.t loc * type_declaration
+        (* with type X.t = ...
+
+           Note: the last component of the longident must match
+           the name of the type_declaration. *)
+  | Pwith_module of Longident.t loc * Longident.t loc
+        (* with module X.Y = Z *)
   | Pwith_typesubst of type_declaration
-  | Pwith_modsubst of Longident.t loc
+        (* with type t := ... *)
+  | Pwith_modsubst of string loc * Longident.t loc
+        (* with module X := Z *)
 
 (* Value expressions for the module language *)
 
 and module_expr =
-  { pmod_desc: module_expr_desc;
-    pmod_loc: Location.t }
+    {
+     pmod_desc: module_expr_desc;
+     pmod_loc: Location.t;
+     pmod_attributes: attributes; (* ... [@id1] [@id2] *)
+    }
 
 and module_expr_desc =
-    Pmod_ident of Longident.t loc
+  | Pmod_ident of Longident.t loc
+        (* X *)
   | Pmod_structure of structure
+        (* struct ... end *)
   | Pmod_functor of string loc * module_type * module_expr
+        (* functor(X : MT1) -> ME *)
   | Pmod_apply of module_expr * module_expr
+        (* ME1(ME2) *)
   | Pmod_constraint of module_expr * module_type
+        (* (ME : MT) *)
   | Pmod_unpack of expression
+        (* (val E) *)
+  | Pmod_extension of extension
+        (* [%id] *)
 
 and structure = structure_item list
 
 and structure_item =
-  { pstr_desc: structure_item_desc;
-    pstr_loc: Location.t }
+    {
+     pstr_desc: structure_item_desc;
+     pstr_loc: Location.t;
+    }
 
 and structure_item_desc =
-    Pstr_eval of expression
-  | Pstr_value of rec_flag * (pattern * expression) list
-  | Pstr_primitive of string loc * value_description
-  | Pstr_type of (string loc * type_declaration) list
-  | Pstr_exception of string loc * exception_declaration
-  | Pstr_exn_rebind of string loc * Longident.t loc
-  | Pstr_module of string loc * module_expr
-  | Pstr_recmodule of (string loc * module_type * module_expr) list
-  | Pstr_modtype of string loc * module_type
-  | Pstr_open of override_flag * Longident.t loc
+  | Pstr_eval of expression * attributes
+        (* E *)
+  | Pstr_value of rec_flag * value_binding list
+        (* let P1 = E1 and ... and Pn = EN       (flag = Nonrecursive)
+           let rec P1 = E1 and ... and Pn = EN   (flag = Recursive)
+         *)
+  | Pstr_primitive of value_description
+        (* external x: T = "s1" ... "sn" *)
+  | Pstr_type of type_declaration list
+        (* type t1 = ... and ... and tn = ... *)
+  | Pstr_exception of constructor_declaration
+        (* exception C of T *)
+  | Pstr_exn_rebind of string loc * Longident.t loc * attributes
+        (* exception C = M.X *)
+  | Pstr_module of module_binding
+        (* module X = ME *)
+  | Pstr_recmodule of module_binding list
+        (* module rec X1 = ME1 and ... and Xn = MEn *)
+  | Pstr_modtype of module_type_declaration
+        (* module type S = MT *)
+  | Pstr_open of override_flag * Longident.t loc * attributes
+        (* open X *)
   | Pstr_class of class_declaration list
+        (* class c1 = ... and ... and cn = ... *)
   | Pstr_class_type of class_type_declaration list
-  | Pstr_include of module_expr
+        (* class type ct1 = ... and ... and ctn = ... *)
+  | Pstr_include of module_expr * attributes
+        (* include ME *)
+  | Pstr_attribute of attribute
+        (* [@@id]
+           (not attached to another item, i.e. after ";;" or at the beginning
+           of the structure) *)
+  | Pstr_extension of extension * attributes
+        (* [%%id] *)
+
+and value_binding =
+  {
+    pvb_pat: pattern;
+    pvb_expr: expression;
+    pvb_attributes: attributes;
+  }
+
+and module_binding =
+    {
+     pmb_name: string loc;
+     pmb_expr: module_expr;
+     pmb_attributes: attributes;
+    }
+(* X = ME *)
+
+(** {2 Toplevel} *)
 
 (* Toplevel phrases *)
 
 type toplevel_phrase =
-    Ptop_def of structure
+  | Ptop_def of structure
   | Ptop_dir of string * directive_argument
 
 and directive_argument =
-    Pdir_none
+  | Pdir_none
   | Pdir_string of string
   | Pdir_int of int
   | Pdir_ident of Longident.t
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 0965ca6aa..f8db3d646 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -64,10 +64,9 @@ let override = function
 
 (* variance encoding: need to sync up with the [parser.mly] *)
 let type_variance = function
-  | (false,false) -> ""
-  | (true,false) -> "+"
-  | (false,true) -> "-"
-  | (_,_) -> assert false
+  | Invariant -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
 
 type construct =
   [ `cons of expression list
@@ -79,22 +78,22 @@ type construct =
 
 let view_expr x =
   match x.pexp_desc with
-  | Pexp_construct ( {txt= Lident "()"; _},_,_) -> `tuple
-  | Pexp_construct ( {txt= Lident "[]";_},_,_) -> `nil
-  | Pexp_construct ( {txt= Lident"::";_},Some _,_) ->
+  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
       let rec loop exp acc = match exp with
-          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_,_);_} ->
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);_} ->
               (List.rev acc,true)
           | {pexp_desc=
              Pexp_construct ({txt=Lident "::";_},
-                             Some ({pexp_desc= Pexp_tuple([e1;e2]);_}),_);_} ->
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);_}));_} ->
               loop e2 (e1::acc)
           | e -> (List.rev (e::acc),false) in
       let (ls,b) = loop x []  in
       if b then
         `list ls
       else `cons ls
-  | Pexp_construct (x,None,_) -> `simple (x.txt)
+  | Pexp_construct (x,None) -> `simple (x.txt)
   | _ -> `normal
 
 let is_simple_construct :construct -> bool = function
@@ -112,8 +111,10 @@ let rec is_irrefut_patt x =
   | Ppat_or (l,r) -> is_irrefut_patt l || is_irrefut_patt r
   | Ppat_record (ls,_) -> List.for_all (fun (_,x) -> is_irrefut_patt x) ls
   | Ppat_lazy p -> is_irrefut_patt p
+  | Ppat_extension _ -> assert false
+  | Ppat_interval _
   | Ppat_constant _ | Ppat_construct _  | Ppat_variant _ | Ppat_array _
-    | Ppat_type _ -> false (*conservative*)
+  | Ppat_type _-> false (*conservative*)
 class printer  ()= object(self:'self)
   val pipe = false
   val semi = false
@@ -175,7 +176,8 @@ class printer  ()= object(self:'self)
   method longident_loc f x = pp f "%a" self#longident x.txt
   method constant f  = function
     | Const_char i -> pp f "%C"  i
-    | Const_string i -> pp f "%S" i
+    | Const_string (i, None) -> pp f "%S" i
+    | Const_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
     | Const_int i -> self#paren (i<0) (fun f -> pp f "%d") f i
     | Const_float  i -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
     | Const_int32 i -> self#paren (i<0l) (fun f -> pp f "%ldl") f i
@@ -195,7 +197,7 @@ class printer  ()= object(self:'self)
   (* trailing space added *)
   method rec_flag f = function
     | Nonrecursive -> ()
-    | Recursive | Default -> pp f "rec "
+    | Recursive -> pp f "rec "
   method direction_flag f = function
     | Upto -> pp f "to@ "
     | Downto -> pp f "downto@ "
@@ -231,7 +233,11 @@ class printer  ()= object(self:'self)
           | _ -> failwith "invalid input in print_type_with_label"
         else pp f "%s:%a" s self#core_type1 c
   method core_type f x =
-    match x.ptyp_desc with
+    if x.ptyp_attributes <> [] then begin
+      pp f "((%a)%a)" self#core_type {x with ptyp_attributes=[]}
+        self#attributes x.ptyp_attributes
+    end
+    else match x.ptyp_desc with
     | Ptyp_arrow (l, ct1, ct2) ->
         pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
           self#type_with_label (l,ct1) self#core_type ct2
@@ -250,7 +256,8 @@ class printer  ()= object(self:'self)
           sl  self#core_type ct
     | _ -> pp f "@[<2>%a@]" self#core_type1 x
   method core_type1 f x =
-    match x.ptyp_desc with
+    if x.ptyp_attributes <> [] then self#core_type f x
+    else match x.ptyp_desc with
     | Ptyp_any -> pp f "_";
     | Ptyp_var s -> self#tyvar f  s;
     | Ptyp_tuple l ->  pp f "(%a)" (self#list self#core_type1 ~sep:"*@;") l
@@ -278,9 +285,9 @@ class printer  ()= object(self:'self)
               | _ ->
               pp f "%s@;%a"
                 (match (closed,low) with
-                | (true,None) -> ""
-                | (true,Some _) -> "<" (* FIXME desugar the syntax sugar *)
-                | (false,_) -> ">")
+                | (Closed,None) -> ""
+                | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+                | (Open,_) -> ">")
                 (self#list type_variant_helper ~sep:"@;<1 -2>| ") l) l
           (fun f low
             ->
@@ -289,20 +296,23 @@ class printer  ()= object(self:'self)
               |Some xs ->
               pp f ">@ %a"
                 (self#list self#string_quot) xs) low
-    | Ptyp_object l ->
-        let  core_field_type f {pfield_desc;_} =
-          match pfield_desc with
-          | Pfield (s, ct) ->
-              pp f "@[<hov2>%s@ :%a@ @]" s self#core_type ct
-          | Pfield_var -> pp f ".." in
-        pp f "@[<hov2><@ %a@ >@]" (self#list core_field_type ~sep:";") l
-    | Ptyp_class (li, l, low) ->   (*FIXME*)
-        pp f "@[<hov2>%a#%a%a@]"
+    | Ptyp_object (l, o) ->
+        let core_field_type f (s, ct) =
+          pp f "@[<hov2>%s@ :%a@ @]" s self#core_type ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open ->
+              match l with
+              | [] -> pp f ".."
+              | _ -> pp f " ;.."
+        in
+        pp f "@[<hov2><@ %a%a@ >@]" (self#list core_field_type ~sep:";") l
+          field_var o
+    | Ptyp_class (li, l) ->   (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
           (self#list self#core_type ~sep:"," ~first:"(" ~last:")") l
           self#longident_loc li
-          (fun f low -> match low with
-          | [] -> ()
-          | _ -> pp f "@ [>@ %a]" (self#list self#string_quot) low) low
     | Ptyp_package (lid, cstrs) ->
         let aux f (s, ct) =
           pp f "type %a@ =@ %a" self#longident_loc s self#core_type ct  in
@@ -311,27 +321,21 @@ class printer  ()= object(self:'self)
         |_ ->
             pp f "@[<hov2>(module@ %a@ with@ %a)@]" self#longident_loc lid
               (self#list aux  ~sep:"@ and@ ")  cstrs)
+    | Ptyp_extension (s, arg) ->
+      pp f "@[<2>(&%s@ %a)@]" s.txt self#payload arg
     | _ -> self#paren true self#core_type f x
           (********************pattern********************)
           (* be cautious when use [pattern], [pattern1] is preferred *)
   method pattern f x =
-    let rec pattern_or_helper  cur = function
-      |{ppat_desc = Ppat_constant (Const_char a);_}
-        ->
-          if Char.code a = Char.code cur + 1 then
-            Some a
-          else None
-      |{ppat_desc =
-        Ppat_or({ppat_desc=Ppat_constant (Const_char a);_}, p2);_} ->
-          if Char.code a = Char.code cur + 1 then
-            pattern_or_helper a p2
-          else None
-      | _ -> None in
     let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
       | {ppat_desc= Ppat_or (p1,p2);_} ->
           list_of_pattern  (p2::acc) p1
       | x -> x::acc in
-    match x.ppat_desc with
+    if x.ppat_attributes <> [] then begin
+      pp f "((%a)%a)" self#pattern {x with ppat_attributes=[]}
+        self#attributes x.ppat_attributes
+    end
+    else match x.ppat_desc with
     | Ppat_alias (p, s) -> pp f "@[<2>%a@;as@;%a@]"
           self#pattern p
           (fun f s->
@@ -340,31 +344,22 @@ class printer  ()= object(self:'self)
             then pp f "( %s )" s.txt
             else pp f "%s" s.txt ) s (* RA*)
     | Ppat_or (p1, p2) -> (* *)
-        (match p1 with
-        | {ppat_desc=Ppat_constant (Const_char a);_} ->
-            (match pattern_or_helper a p2 with
-            |Some b -> pp f "@[<2>%C..%C@]" a b
-            |None ->
-                pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern)
-                   (list_of_pattern [] x))
-        | _ ->
-            pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern)
-               (list_of_pattern [] x)
-        )
+        pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern) (list_of_pattern [] x)
     | _ -> self#pattern1 f x
   method pattern1 (f:Format.formatter) (x:pattern) :unit =
     let rec pattern_list_helper f  =  function
       | {ppat_desc =
          Ppat_construct
            ({ txt = Lident("::") ;_},
-            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}),
-            _);_} ->
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_})); _}
+            ->
               pp f "%a::%a"  self#simple_pattern  pat1  pattern_list_helper pat2 (*RA*)
       | p -> self#pattern1 f p in
-    match x.ppat_desc with
+    if x.ppat_attributes <> [] then self#pattern f x
+    else match x.ppat_desc with
     | Ppat_variant (l, Some p) ->  pp f "@[<2>`%s@;%a@]" l self#pattern1 p (*RA*)
-    | Ppat_construct (({txt=Lident("()"|"[]");_}), _, _) -> self#simple_pattern f x
-    | Ppat_construct (({txt;_} as li), po, _) -> (* FIXME The third field always false *)
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> self#simple_pattern f x
+    | Ppat_construct (({txt;_} as li), po) -> (* FIXME The third field always false *)
         if txt = Lident "::" then
           pp f "%a" pattern_list_helper x
         else
@@ -375,7 +370,7 @@ class printer  ()= object(self:'self)
     | _ -> self#simple_pattern f x
   method simple_pattern (f:Format.formatter) (x:pattern) :unit =
     match x.ppat_desc with
-    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _, _) -> pp f  "%s" x
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
     | Ppat_any -> pp f "_";
     | Ppat_var ({txt = txt;_}) ->
         if (is_infix (fixity_of_string txt)) || List.mem txt.[0] prefix_symbols then
@@ -407,6 +402,7 @@ class printer  ()= object(self:'self)
               (self#list longident_x_pattern ~sep:";@;") l)
     | Ppat_tuple l -> pp f "@[<1>(%a)@]" (self#list  ~sep:"," self#pattern1)  l (* level1*)
     | Ppat_constant (c) -> pp f "%a" self#constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" self#constant c1 self#constant c2
     | Ppat_variant (l,None) ->  pp f "`%s" l
     | Ppat_constraint (p, ct) ->
         pp f "@[<2>(%a@;:@;%a)@]" self#pattern1 p self#core_type ct
@@ -436,7 +432,9 @@ class printer  ()= object(self:'self)
             pp f "~%s@;" l
         | _ ->  pp f "~%s:%a@;" l self#simple_pattern p )
   method sugar_expr f e =
-    match e.pexp_desc with
+    if e.pexp_attributes <> [] then false
+      (* should also check attributes underneath *)
+    else match e.pexp_desc with
     | Pexp_apply
         ({pexp_desc=
           Pexp_ident
@@ -516,34 +514,24 @@ class printer  ()= object(self:'self)
 
     | _ -> false
   method expression f x =
-    match x.pexp_desc with
-    | Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+    if x.pexp_attributes <> [] then begin
+      pp f "((%a)%a)" self#expression {x with pexp_attributes=[]}
+        self#attributes x.pexp_attributes
+    end
+    else match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
       when pipe || semi ->
         self#paren true self#reset#expression f x
     | Pexp_ifthenelse _ | Pexp_sequence _ when ifthenelse ->
         self#paren true self#reset#expression f x
     | Pexp_let _ | Pexp_letmodule _ when semi ->
         self#paren true self#reset#expression f x
-    | Pexp_function _(* (p, eo, l) *) ->
-        let rec aux acc = function
-          | {pexp_desc = Pexp_function (l,eo, [(p',e')]);_}
-              -> aux ((l,eo,p')::acc) e'
-          | x -> (List.rev acc,x)  in
-        begin match aux [] x with
-        | [], {pexp_desc=Pexp_function(_label,_eo,l);_} -> (* label should be "" *)
-            pp f "@[<hv>function%a@]" self#case_list l
-        | ls, {pexp_desc=Pexp_when(e1,e2);_}->
-            pp f "@[<2>fun@;%a@;when@;%a@;->@;%a@]"
-            (self#list
-               (fun f (l,eo,p) ->
-                 self#label_exp  f (l,eo,p) )) ls
-              self#reset#expression e1 self#expression e2
-        | ls, e ->
-            pp f "@[<2>fun@;%a@;->@;%a@]"
-              (self#list
-                 (fun f (l,eo,p) ->
-                   self#label_exp f (l,eo,p))) ls
-              self#expression e end
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a@;->@;%a@]"
+          self#label_exp (l, e0, p)
+          self#expression e
+    | Pexp_function l ->
+        pp f "@[<hv>function%a@]" self#case_list l
     | Pexp_match (e, l) ->
         pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]" self#reset#expression e self#case_list l
 
@@ -581,7 +569,7 @@ class printer  ()= object(self:'self)
                (*reset here only because [function,match,try,sequence] are lower priority*)
             end (e,l))
 
-    | Pexp_construct (li, Some eo, _)
+    | Pexp_construct (li, Some eo)
       when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
         (match view_expr x with
         | `cons ls -> self#list self#simple_expr f ls ~sep:"@;::@;"
@@ -606,7 +594,6 @@ class printer  ()= object(self:'self)
         let lst = sequence_helper [] x in
         pp f "@[<hv>%a@]"
           (self#list self#under_semi#expression ~sep:";@;") lst
-    | Pexp_when (_e1, _e2) ->  assert false (*FIXME handled already in pattern *)
     | Pexp_new (li) ->
         pp f "@[<hov2>new@ %a@]" self#longident_loc li;
     | Pexp_setinstvar (s, e) ->
@@ -621,8 +608,6 @@ class printer  ()= object(self:'self)
           self#reset#module_expr me  self#expression e
     | Pexp_assert e ->
         pp f "@[<hov2>assert@ %a@]" self#simple_expr e
-    | Pexp_assertfalse ->
-        pp f "@[<2>assert@;false@]" ;
     | Pexp_lazy (e) ->
         pp f "@[<hov2>lazy@ %a@]" self#simple_expr e
     | Pexp_poly _ ->
@@ -632,20 +617,25 @@ class printer  ()= object(self:'self)
           self#expression  e
     | Pexp_variant (l,Some eo) ->
         pp f "@[<2>`%s@;%a@]" l  self#simple_expr eo
+    | Pexp_extension (s, arg) ->
+      pp f "@[<2>(&%s@ %a)@]" s.txt self#payload arg
     | _ -> self#expression1 f x
   method expression1 f x =
-    match x.pexp_desc with
+    if x.pexp_attributes <> [] then self#expression f x
+    else match x.pexp_desc with
     | Pexp_object cs -> pp f "%a" self#class_structure cs
     | _ -> self#expression2 f x
   (* used in [Pexp_apply] *)
   method expression2 f x =
-    match x.pexp_desc with
+    if x.pexp_attributes <> [] then self#expression f x
+    else match x.pexp_desc with
     | Pexp_field (e, li) -> pp f "@[<hov2>%a.%a@]" self#simple_expr e self#longident_loc li
     | Pexp_send (e, s) ->  pp f "@[<hov2>%a#%s@]" self#simple_expr e  s
 
     | _ -> self#simple_expr f x
   method simple_expr f x =
-    match x.pexp_desc with
+    if x.pexp_attributes <> [] then self#expression f x
+    else match x.pexp_desc with
     | Pexp_construct _  when is_simple_construct (view_expr x) ->
         (match view_expr x with
         | `nil -> pp f "[]"
@@ -665,10 +655,12 @@ class printer  ()= object(self:'self)
         pp f "fun@;(type@;%s)@;->@;%a"  lid  self#expression  e
     | Pexp_tuple l ->
         pp f "@[<hov2>(%a)@]"  (self#list self#simple_expr  ~sep:",@;")  l
-    | Pexp_constraint (e, cto1, cto2) ->
-        pp f "(%a%a%a)" self#expression e
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" self#expression e self#core_type ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" self#expression e
           (self#option self#core_type ~first:" : " ~last:" ") cto1 (* no sep hint*)
-          (self#option self#core_type ~first:" :>") cto2
+          self#core_type ct
     | Pexp_variant (l, None) -> pp f "`%s" l
     | Pexp_record (l, eo) ->
         let longident_x_expression f ( li, e) =
@@ -692,6 +684,11 @@ class printer  ()= object(self:'self)
         pp f fmt s.txt self#expression e1 self#direction_flag df self#expression e2  self#expression e3
     | _ ->  self#paren true self#expression f x
 
+  method attributes f l =
+    List.iter (self # attribute f) l
+
+  method attribute f (s, e) =
+    pp f "[@@%s %a]" s.txt self#payload e
 
   method value_description f x =
     pp f "@[<hov2>%a%a@]" self#core_type x.pval_type
@@ -703,30 +700,28 @@ class printer  ()= object(self:'self)
         end) x
 
 
-  method exception_declaration f (s,ed) =
-    pp f "@[<hov2>exception@ %s%a@]" s
+  method exception_declaration f cd =
+    pp f "@[<hov2>exception@ %s%a@]" cd.pcd_name.txt
       (fun f ed -> match ed with
       |[] -> ()
-      |_ -> pp f "@ of@ %a" (self#list ~sep:"*" self#core_type) ed) ed
-
+      |_ -> pp f "@ of@ %a" (self#list ~sep:"*" self#core_type) ed) cd.pcd_args
 
   method class_signature f { pcsig_self = ct; pcsig_fields = l ;_} =
     let class_type_field f x =
       match x.pctf_desc with
-      | Pctf_inher (ct) ->
+      | Pctf_inherit (ct) ->
           pp f "@[<2>inherit@ %a@]" self#class_type ct
       | Pctf_val (s, mf, vf, ct) ->
           pp f "@[<2>val @ %a%a%s@ :@ %a@]"
             self#mutable_flag mf self#virtual_flag vf s  self#core_type  ct
-      | Pctf_virt (s, pf, ct) ->    (* todo: test this *)
-          pp f "@[<2>method@ %a@ virtual@ %s@ :@ %a@]"
-            self#private_flag pf s  self#core_type ct
-      | Pctf_meth (s, pf, ct) ->
-          pp f "@[<2>method %a%s :@;%a@]"
-            self#private_flag pf s self#core_type ct
-      | Pctf_cstr (ct1, ct2) ->
+      | Pctf_method (s, pf, vf, ct) ->
+          pp f "@[<2>method %a %a%s :@;%a@]"
+            self#private_flag pf self#virtual_flag vf s self#core_type ct
+      | Pctf_constraint (ct1, ct2) ->
           pp f "@[<2>constraint@ %a@ =@ %a@]"
-            self#core_type ct1 self#core_type ct2 in
+            self#core_type ct1 self#core_type ct2
+      | Pctf_extension _ -> assert false
+    in
     pp f "@[<hv0>@[<hv2>object @[<1>%a@]@ %a@]@ end@]"
       (fun f ct -> match ct.ptyp_desc with
       | Ptyp_any -> ()
@@ -743,16 +738,17 @@ class printer  ()= object(self:'self)
           | [] -> ()
           | _  -> pp f "[%a]@ " (self#list self#core_type ~sep:"," ) l) l
           self#longident_loc li
-    | Pcty_fun (l, co, cl) ->
+    | Pcty_arrow (l, co, cl) ->
         pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
           self#type_with_label (l,co) self#class_type cl
+    | Pcty_extension _ -> assert false
 
 
   (* [class type a = object end] *)
   method class_type_declaration_list f  l =
-    let class_type_declaration f ({pci_params=(ls,_);pci_name={txt;_};pci_variance;_} as x) =
+    let class_type_declaration f ({pci_params=ls;pci_name={txt;_};_} as x) =
       pp f "%a%a%s@ =@ %a" self#virtual_flag x.pci_virt
-        self#class_params_def (List.combine ls pci_variance) txt
+        self#class_params_def ls txt
         self#class_type x.pci_expr in
     match l with
     | [] -> ()
@@ -763,22 +759,22 @@ class printer  ()= object(self:'self)
 
   method class_field f x =
     match x.pcf_desc with
-    | Pcf_inher (ovf, ce, so) ->
+    | Pcf_inherit (ovf, ce, so) ->
         pp f "@[<2>inherit@ %s@ %a%a@]"  (override ovf) self#class_expr ce
           (fun f so -> match so with
           | None -> ();
           | Some (s) -> pp f "@ as %s" s ) so
-    | Pcf_val (s, mf, ovf, e) ->
+    | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
         pp f "@[<2>val%s %a%s =@;%a@]" (override ovf)  self#mutable_flag mf
           s.txt  self#expression  e
-    | Pcf_virt (s, pf, ct) ->
+    | Pcf_method (s, pf, Cfk_virtual ct) ->
         pp f "@[<2>method virtual %a %s :@;%a@]"
           self#private_flag pf s.txt self#core_type  ct
-    | Pcf_valvirt (s, mf, ct) ->
+    | Pcf_val (s, mf, Cfk_virtual ct) ->
         pp f "@[<2>val virtual %a%s :@ %a@]"
           self#mutable_flag mf s.txt
           self#core_type  ct
-    | Pcf_meth (s, pf, ovf, e) ->
+    | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
         pp f "@[<2>method%s %a%a@]"
           (override ovf)
           self#private_flag pf
@@ -787,15 +783,18 @@ class printer  ()= object(self:'self)
               pp f "%s :@;%a=@;%a"
                 s.txt (self#core_type) ct self#expression e
           | Pexp_poly (e,None) ->
-              self#binding f ({ppat_desc=Ppat_var s;ppat_loc=Location.none} ,e)
+              self#binding f {pvb_pat={ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
+                              pvb_expr=e;
+                              pvb_attributes=[]}
           | _ ->
               self#expression f e ) e
-    | Pcf_constr (ct1, ct2) ->
+    | Pcf_constraint (ct1, ct2) ->
         pp f "@[<2>constraint %a =@;%a@]" self#core_type  ct1 self#core_type  ct2
-    | Pcf_init (e) ->
+    | Pcf_initializer (e) ->
         pp f "@[<2>initializer@ %a@]" self#expression e
+    | Pcf_extension _ -> assert false
 
-  method class_structure f { pcstr_pat = p; pcstr_fields =  l } =
+  method class_structure f { pcstr_self = p; pcstr_fields =  l } =
     pp f "@[<hv0>@[<hv2>object %a@;%a@]@;end@]"
       (fun f p -> match p.ppat_desc with
       | Ppat_any -> ()
@@ -826,8 +825,7 @@ class printer  ()= object(self:'self)
         pp f "(%a@ :@ %a)"
           self#class_expr ce
           self#class_type ct
-
-
+    | Pcl_extension _ -> assert false
 
   method module_type f x =
     match x.pmty_desc with
@@ -840,51 +838,54 @@ class printer  ()= object(self:'self)
         pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
           self#module_type mt1  self#module_type mt2
     | Pmty_with (mt, l) ->
-        let longident_x_with_constraint f (li, wc) =
-          match wc with
-          | Pwith_type ({ptype_params= ls ;_} as td) ->
+        let with_constraint f = function
+          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+              let ls = List.map fst ls in
               pp f "type@ %a %a =@ %a"
                 (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
                 ls self#longident_loc li  self#type_declaration  td
-          | Pwith_module (li2) ->
+          | Pwith_module (li, li2) ->
               pp f "module %a =@ %a" self#longident_loc li self#longident_loc li2;
           | Pwith_typesubst ({ptype_params=ls;_} as td) ->
-              pp f "type@ %a %a :=@ %a"
+              let ls = List.map fst ls in
+              pp f "type@ %a %s :=@ %a"
                 (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
-                ls self#longident_loc li
+                ls td.ptype_name.txt
                 self#type_declaration  td
-          | Pwith_modsubst (li2) ->
-              pp f "module %a :=@ %a" self#longident_loc li self#longident_loc li2 in
+          | Pwith_modsubst (s, li2) ->
+              pp f "module %s :=@ %a" s.txt self#longident_loc li2 in
         (match l with
         | [] -> pp f "@[<hov2>%a@]" self#module_type mt
         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
-              self#module_type mt (self#list longident_x_with_constraint ~sep:"@ and@ ") l )
+              self#module_type mt (self#list with_constraint ~sep:"@ and@ ") l )
     | Pmty_typeof me ->
         pp f "@[<hov2>module@ type@ of@ %a@]"
           self#module_expr me
+    | Pmty_extension _ -> assert false
+
   method signature f x =  self#list ~sep:"@\n" self#signature_item f x
 
   method signature_item f x :unit= begin
     match x.psig_desc with
     | Psig_type l ->
         self#type_def_list f l
-    | Psig_value (s, vd) ->
+    | Psig_value vd ->
         pp f "@[<2>%a@]"
-          (fun f (s,vd) ->
+          (fun f vd ->
             let intro = if vd.pval_prim = [] then "val" else "external" in
-            if (is_infix (fixity_of_string s.txt)) || List.mem s.txt.[0] prefix_symbols then
-              pp f "%s@ (@ %s@ )@ :@ " intro s.txt
+            if (is_infix (fixity_of_string vd.pval_name.txt)) || List.mem vd.pval_name.txt.[0] prefix_symbols then
+              pp f "%s@ (@ %s@ )@ :@ " intro vd.pval_name.txt
             else
-              pp f "%s@ %s@ :@ " intro s.txt;
-            self#value_description f vd;) (s,vd)
-    | Psig_exception (s, ed) ->
-        self#exception_declaration f (s.txt,ed)
+              pp f "%s@ %s@ :@ " intro vd.pval_name.txt;
+            self#value_description f vd;) vd
+    | Psig_exception ed ->
+        self#exception_declaration f ed
     | Psig_class l ->
-        let class_description f ({pci_params=(ls,_);pci_name={txt;_};pci_variance;_} as x) =
+        let class_description f ({pci_params=ls;pci_name={txt;_};_} as x) =
           pp f "%a%a%s@;:@;%a" (* "@[<2>class %a%a%s@;:@;%a@]" *)
             self#virtual_flag x.pci_virt
             self#class_params_def
-            (List.combine ls pci_variance)
+            ls
             txt  self#class_type x.pci_expr in
         pp f  "@[<0>%a@]"
           (fun f l ->  match l with
@@ -892,21 +893,21 @@ class printer  ()= object(self:'self)
             |[x] -> pp f "@[<2>class %a@]" class_description x
             |_ -> self#list ~first:"@[<v0>class @[<2>" ~sep:"@]@;and @[" ~last:"@]@]"
                   class_description f l) l
-    | Psig_module (s, mt) ->
+    | Psig_module pmd ->
         pp f "@[<hov>module@ %s@ :@ %a@]"
-          s.txt
-          self#module_type  mt
-    | Psig_open (ovf, li) ->
+          pmd.pmd_name.txt
+          self#module_type  pmd.pmd_type
+    | Psig_open (ovf, li, _attrs) ->
         pp f "@[<hov2>open%s@ %a@]" (override ovf) self#longident_loc li
-    | Psig_include (mt) ->
+    | Psig_include (mt, _attrs) ->
         pp f "@[<hov2>include@ %a@]"
           self#module_type  mt
-    | Psig_modtype (s, md) ->
+    | Psig_modtype {pmtd_name=s; pmtd_type=md} ->
         pp f "@[<hov2>module@ type@ %s%a@]"
           s.txt
           (fun f md -> match md with
-          | Pmodtype_abstract -> ()
-          | Pmodtype_manifest (mt) ->
+          | None -> ()
+          | Some mt ->
               pp_print_space f () ;
               pp f "@ =@ %a"  self#module_type mt
           ) md
@@ -916,15 +917,17 @@ class printer  ()= object(self:'self)
         let rec  string_x_module_type_list f ?(first=true) l =
           match l with
           | [] -> () ;
-          | (s,mty) :: tl ->
+          | pmd :: tl ->
               if not first then
                 pp f "@ @[<hov2>and@ %s:@ %a@]"
-                  s.txt self#module_type mty
+                  pmd.pmd_name.txt self#module_type pmd.pmd_type
               else
                 pp f "@ @[<hov2>module@ rec@ %s:@ %a@]"
-                  s.txt self#module_type mty;
+                  pmd.pmd_name.txt self#module_type pmd.pmd_type;
               string_x_module_type_list f ~first:false tl  in
         string_x_module_type_list f decls
+    | Psig_attribute _
+    | Psig_extension _ -> assert false
   end
   method module_expr f x =
     match x.pmod_desc with
@@ -944,35 +947,41 @@ class printer  ()= object(self:'self)
         pp f "%a(%a)" self#module_expr me1  self#module_expr  me2
     | Pmod_unpack e ->
         pp f "(val@ %a)"  self#expression  e
+    | Pmod_extension _ -> assert false
 
   method structure f x = self#list ~sep:"@\n" self#structure_item f x
 
+  method payload f = function
+    | PStr x -> self#structure f x
+    | PTyp x -> pp f ":"; self#core_type f x
+    | PPat (x, None) -> pp f "?"; self#pattern f x
+    | PPat (x, Some e) ->
+      pp f "?"; self#pattern f x;
+      pp f " when "; self#expression f e
+
   (* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
-  method binding f ((p:pattern),(x:expression)) =
+  method binding f {pvb_pat=p; pvb_expr=x; pvb_attributes=_} = (* TODO: print attributes *)
     let rec pp_print_pexp_function f x =
-      match x.pexp_desc with
-      | Pexp_function (label,eo,[(p,e)]) ->
+      if x.pexp_attributes <> [] then pp f "=@;%a" self#expression x
+      else match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
           if label="" then
-            match e.pexp_desc with
-            | Pexp_when _  -> pp f "=@;%a" self#expression x
-            | _ ->
-                pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function e
+            pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function e
           else
             pp f "%a@ %a" self#label_exp (label,eo,p) pp_print_pexp_function e
       | Pexp_newtype (str,e) ->
           pp f "(type@ %s)@ %a" str pp_print_pexp_function e
       | _ -> pp f "=@;%a" self#expression x in
-    match (x.pexp_desc,p.ppat_desc) with
-    | (Pexp_when (e1,e2),_) ->
-        pp f "=@[<2>fun@ %a@ when@ %a@ ->@ %a@]"
-          self#simple_pattern p self#expression e1 self#expression e2
+    if x.pexp_attributes <> [] then
+      pp f "%a@;=@;%a" self#pattern p self#expression x
+    else match (x.pexp_desc,p.ppat_desc) with
     | ( _ , Ppat_constraint( p ,ty)) -> (* special case for the first*)
         (match ty.ptyp_desc with
         | Ptyp_poly _ ->
             pp f "%a@;:@;%a=@;%a" self#simple_pattern p  self#core_type ty self#expression x
         | _ ->
             pp f "(%a@;:%a)=@;%a" self#simple_pattern p  self#core_type ty self#expression x)
-    | Pexp_constraint (e,Some t1,None),Ppat_var {txt;_} ->
+    | Pexp_constraint (e,t1),Ppat_var {txt;_} ->
         pp f "%s:@ %a@;=@;%a" txt self#core_type t1  self#expression e
     | (_, Ppat_var _) ->
         pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function x
@@ -1006,21 +1015,21 @@ class printer  ()= object(self:'self)
 
   method structure_item f x = begin
     match x.pstr_desc with
-    | Pstr_eval (e) ->
+    | Pstr_eval (e, _attrs) ->
         pp f "@[<hov2>let@ _ =@ %a@]" self#expression e
     | Pstr_type [] -> assert false
     | Pstr_type l  -> self#type_def_list f l
     | Pstr_value (rf, l) -> (* pp f "@[<hov2>let %a%a@]"  self#rec_flag rf self#bindings l *)
         pp f "@[<2>%a@]" self#bindings (rf,l)
-    | Pstr_exception (s, ed) -> self#exception_declaration f (s.txt,ed)
-    | Pstr_module (s, me) ->
+    | Pstr_exception ed -> self#exception_declaration f ed
+    | Pstr_module x ->
         let rec module_helper me = match me.pmod_desc with
         | Pmod_functor(s,mt,me) ->
             pp f "(%s:%a)"  s.txt  self#module_type mt ;
             module_helper me
         | _ -> me in
         pp f "@[<hov2>module %s%a@]"
-          s.txt
+          x.pmb_name.txt
           (fun f me ->
             let me = module_helper me  in
             (match me.pmod_desc with
@@ -1030,20 +1039,26 @@ class printer  ()= object(self:'self)
             | Pmty_signature (_));_} as mt)) ->
                 pp f " :@;%a@;=@;%a@;"  self#module_type mt self#module_expr  me
             | _ ->
-                pp f " =@ %a"  self#module_expr  me
-            )) me
-    | Pstr_open (ovf, li) ->
+                pp f " =@ %a"  self#module_expr  me 
+            )) x.pmb_expr
+    | Pstr_open (ovf, li, _attrs) ->
         pp f "@[<2>open%s@;%a@]" (override ovf) self#longident_loc li;
-    | Pstr_modtype (s, mt) ->
-        pp f "@[<2>module type %s =@;%a@]" s.txt self#module_type mt
+    | Pstr_modtype {pmtd_name=s; pmtd_type=md} ->
+        pp f "@[<hov2>module@ type@ %s%a@]"
+          s.txt
+          (fun f md -> match md with
+          | None -> ()
+          | Some mt ->
+              pp_print_space f () ;
+              pp f "@ =@ %a"  self#module_type mt
+          ) md
     | Pstr_class l ->
         let class_declaration f  (* for the second will be changed to and FIXME*)
-            ({pci_params=(ls,_);
+            ({pci_params=ls;
               pci_name={txt;_};
               pci_virt;
               pci_expr={pcl_desc;_};
-              pci_variance;_ } as x) =
-          let ls = List.combine ls pci_variance in
+              _ } as x) =
           let rec  class_fun_helper f e = match e.pcl_desc with
           | Pcl_fun (l, eo, p, e) ->
               self#label_exp f (l,eo,p);
@@ -1072,38 +1087,43 @@ class printer  ()= object(self:'self)
               ~last:"@]@]" class_declaration f xs)
     | Pstr_class_type (l) ->
         self#class_type_declaration_list f l ;
-    | Pstr_primitive (s, vd) ->
+    | Pstr_primitive vd ->
         let need_parens =
-          match s.txt with
+          match vd.pval_name.txt with
           | "or" | "mod" | "land"| "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
-          | _ -> match s.txt.[0] with
+          | _ -> match vd.pval_name.txt.[0] with
               'a'..'z' -> false | _ -> true in
         pp f "@[<hov2>external@ %s@ :@ %a@]"
-          (if need_parens then "( "^s.txt^" )" else s.txt)
+          (if need_parens then "( "^vd.pval_name.txt^" )" else vd.pval_name.txt)
           self#value_description  vd
-    | Pstr_include me ->
+    | Pstr_include (me, _attrs) ->
         pp f "@[<hov2>include@ %a@]"  self#module_expr  me
-    | Pstr_exn_rebind (s, li) ->        (* todo: check this *)
+    | Pstr_exn_rebind (s, li, _attrs) ->        (* todo: check this *)
         pp f "@[<hov2>exception@ %s@ =@ %a@]" s.txt self#longident_loc li
     | Pstr_recmodule decls -> (* 3.07 *)
-        let text_x_modtype_x_module f (s, mt, me) =
-          pp f "@[<hov2>and@ %s:%a@ =@ %a@]"
-            s.txt self#module_type mt self#module_expr me
-        in match decls with
-        | (s,mt,me):: l2 ->
+        let aux f = function
+          | {pmb_name = s; pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} ->
+              pp f "@[<hov2>and@ %s:%a@ =@ %a@]"
+              s.txt self#module_type typ self#module_expr expr
+          | _ -> assert false
+        in
+        begin match decls with
+        | {pmb_name = s; pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} :: l2 ->
             pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]@ %a@]"
               s.txt
-              self#module_type mt
-              self#module_expr me
-              (fun f l2 -> List.iter (text_x_modtype_x_module f) l2) l2
+              self#module_type typ
+              self#module_expr expr
+              (fun f l2 -> List.iter (aux f) l2) l2
         | _ -> assert false
+        end
+    | Pstr_attribute _ -> ()
+    | Pstr_extension _ -> assert false
   end
-  method type_param f  = function
-    | (a,opt) -> pp f "%s%a" (type_variance a ) self#type_var_option opt
+  method type_param f (opt, a) =
+    pp f "%s%a" (type_variance a ) self#type_var_option opt
           (* shared by [Pstr_type,Psig_type]*)
   method  type_def_list f  l =
-    let aux f (s, ({ptype_params;ptype_kind;ptype_manifest;ptype_variance;_} as td )) =
-      let ptype_params = List.combine  ptype_variance ptype_params in
+    let aux f ({ptype_name = s; ptype_params;ptype_kind;ptype_manifest;_} as td) =
       pp f "%a%s%a"
         (fun f l -> match l with
         |[] -> ()
@@ -1120,15 +1140,15 @@ class printer  ()= object(self:'self)
           (self#list aux ~sep:"@]@,@[<2>and " ~last:"@]@]") xs
           (* called by type_def_list *)
   method type_declaration f x = begin
-    let  type_variant_leaf f  (s, l,gadt, _loc)  = match gadt with
+    let  type_variant_leaf f  {pcd_name; pcd_args; pcd_res; pcd_loc=_} = match pcd_res with
     |None ->
-        pp f "@\n|@;%s%a" s.txt
+        pp f "@\n|@;%s%a" pcd_name.txt
           (fun f l -> match l with
           | [] -> ()
-          | _ -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l) l
+          | _ -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l) pcd_args
     |Some x ->
-        pp f "@\n|@;%s:@;%a" s.txt
-          (self#list self#core_type1 ~sep:"@;->@;") (l@[x]) in
+        pp f "@\n|@;%s:@;%a" pcd_name.txt
+          (self#list self#core_type1 ~sep:"@;->@;") (pcd_args@[x]) in
     pp f "%a%a@ %a"
       (fun f x -> match (x.ptype_manifest,x.ptype_kind,x.ptype_private) with
       | (None,_,Public) ->  pp f "@;"
@@ -1149,8 +1169,8 @@ class printer  ()= object(self:'self)
             (self#list ~sep:"" type_variant_leaf) xs
       | Ptype_abstract -> ()
       | Ptype_record l ->
-          let type_record_field f (s, mf, ct,_) =
-            pp f "@[<2>%a%s:@;%a@]" self#mutable_flag mf s.txt self#core_type ct in
+          let type_record_field f pld =
+            pp f "@[<2>%a%s:@;%a@]" self#mutable_flag pld.pld_mutable pld.pld_name.txt self#core_type pld.pld_type in
           pp f "{@\n%a}"
             (self#list type_record_field ~sep:";@\n" )  l ;
       ) x
@@ -1158,15 +1178,12 @@ class printer  ()= object(self:'self)
          (fun f (ct1,ct2,_) ->
            pp f "@[<hov2>constraint@ %a@ =@ %a@]"
              self#core_type ct1 self#core_type ct2 ))  x.ptype_cstrs  ;
+      (* TODO: attributes *)
   end
-  method case_list f (l:(pattern * expression) list) :unit=
-    let aux f (p,e) =
-      let (e,w) =
-        (match e with
-        | {pexp_desc = Pexp_when (e1, e2);_} -> (e2, Some (e1))
-        | _ -> (e, None)) in
+  method case_list f l : unit =
+    let aux f {pc_lhs; pc_guard; pc_rhs} =
       pp f "@;| @[<2>%a%a@;->@;%a@]"
-        self#pattern p (self#option self#expression ~first:"@;when@;") w self#under_pipe#expression e in
+        self#pattern pc_lhs (self#option self#expression ~first:"@;when@;") pc_guard self#under_pipe#expression pc_rhs in
     self#list aux f l ~sep:""
   method label_x_expression_param f (l,e) =
     match l with
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index e84ee0307..86297cea8 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -17,18 +17,17 @@ class printer :
     val pipe : bool
     val semi : bool
     method binding :
-      Format.formatter -> Parsetree.pattern * Parsetree.expression -> unit
+      Format.formatter -> Parsetree.value_binding -> unit
     method bindings:
         Format.formatter ->
-          Asttypes.rec_flag * (Parsetree.pattern * Parsetree.expression) list ->
+          Asttypes.rec_flag * Parsetree.value_binding list ->
             unit
     method case_list :
-      Format.formatter ->
-      (Parsetree.pattern * Parsetree.expression) list -> unit
+      Format.formatter -> Parsetree.case list -> unit
     method class_expr : Format.formatter -> Parsetree.class_expr -> unit
     method class_field : Format.formatter -> Parsetree.class_field -> unit
     method class_params_def :
-      Format.formatter -> (string Asttypes.loc * (bool * bool)) list -> unit
+      Format.formatter -> (string Asttypes.loc * Asttypes.variance) list -> unit
     method class_signature :
       Format.formatter -> Parsetree.class_signature -> unit
     method class_structure :
@@ -45,7 +44,7 @@ class printer :
     method directive_argument :
       Format.formatter -> Parsetree.directive_argument -> unit
     method exception_declaration :
-      Format.formatter -> string * Parsetree.exception_declaration -> unit
+      Format.formatter -> Parsetree.constructor_declaration -> unit
     method expression : Format.formatter -> Parsetree.expression -> unit
     method expression1 : Format.formatter -> Parsetree.expression -> unit
     method expression2 : Format.formatter -> Parsetree.expression -> unit
@@ -76,6 +75,7 @@ class printer :
           (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
     method pattern : Format.formatter -> Parsetree.pattern -> unit
     method pattern1 : Format.formatter -> Parsetree.pattern -> unit
+    method payload : Format.formatter -> Parsetree.payload -> unit
     method private_flag : Format.formatter -> Asttypes.private_flag -> unit
     method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
 
@@ -101,10 +101,9 @@ class printer :
     method type_declaration :
       Format.formatter -> Parsetree.type_declaration -> unit
     method type_def_list :
-      Format.formatter ->
-      (string Asttypes.loc * Parsetree.type_declaration) list -> unit
+      Format.formatter -> Parsetree.type_declaration list -> unit
     method type_param :
-      Format.formatter -> (bool * bool) * string Asttypes.loc option -> unit
+      Format.formatter -> string Asttypes.loc option * Asttypes.variance -> unit
     method type_var_option :
       Format.formatter -> string Asttypes.loc option -> unit
     method type_with_label :
@@ -116,6 +115,8 @@ class printer :
     method value_description :
       Format.formatter -> Parsetree.value_description -> unit
     method virtual_flag : Format.formatter -> Asttypes.virtual_flag -> unit
+    method attribute : Format.formatter -> Parsetree.attribute -> unit
+    method attributes : Format.formatter -> Parsetree.attributes -> unit
   end
 val default : printer
 val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 22c68ee4b..dfaf8ce8b 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -53,7 +53,9 @@ let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
   | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
-  | Const_string (s) -> fprintf f "Const_string %S" s;
+  | Const_string (s, None) -> fprintf f "Const_string(%S,None)" s;
+  | Const_string (s, Some delim) ->
+      fprintf f "Const_string (%S,Some %S)" s delim;
   | Const_float (s) -> fprintf f "Const_float %s" s;
   | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
   | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
@@ -78,11 +80,15 @@ let fmt_override_flag f x =
   | Fresh -> fprintf f "Fresh";
 ;;
 
+let fmt_closed_flag f x =
+  match x with
+  | Closed -> fprintf f "Closed"
+  | Open -> fprintf f "Open"
+
 let fmt_rec_flag f x =
   match x with
   | Nonrecursive -> fprintf f "Nonrec";
   | Recursive -> fprintf f "Rec";
-  | Default -> fprintf f "Default";
 ;;
 
 let fmt_direction_flag f x =
@@ -127,6 +133,7 @@ let label i ppf x = line i ppf "label=\"%s\"\n" x;;
 
 let rec core_type i ppf x =
   line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
+  attributes i ppf x.ptyp_attributes;
   let i = i+1 in
   match x.ptyp_desc with
   | Ptyp_any -> line i ppf "Ptyp_any\n";
@@ -143,16 +150,21 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_constr %a\n" fmt_longident_loc li;
       list i core_type ppf l;
   | Ptyp_variant (l, closed, low) ->
-      line i ppf "Ptyp_variant closed=%s\n" (string_of_bool closed);
+      line i ppf "Ptyp_variant closed=%a\n" fmt_closed_flag closed;
       list i label_x_bool_x_core_type_list ppf l;
       option i (fun i -> list i string) ppf low
-  | Ptyp_object (l) ->
-      line i ppf "Ptyp_object\n";
-      list i core_field_type ppf l;
-  | Ptyp_class (li, l, low) ->
+  | Ptyp_object (l, c) ->
+      line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
+      let i = i + 1 in
+      List.iter
+        (fun (s, t) ->
+          line i ppf "method %s" s;
+          core_type (i + 1) ppf t
+        )
+        l
+  | Ptyp_class (li, l) ->
       line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
-      list i core_type ppf l;
-      list i string ppf low
+      list i core_type ppf l
   | Ptyp_alias (ct, s) ->
       line i ppf "Ptyp_alias \"%s\"\n" s;
       core_type i ppf ct;
@@ -163,22 +175,17 @@ let rec core_type i ppf x =
   | Ptyp_package (s, l) ->
       line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
       list i package_with ppf l;
+  | Ptyp_extension (s, arg) ->
+      line i ppf "Ptyp_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident_loc s;
   core_type i ppf t
 
-and core_field_type i ppf x =
-  line i ppf "core_field_type %a\n" fmt_location x.pfield_loc;
-  let i = i+1 in
-  match x.pfield_desc with
-  | Pfield (s, ct) ->
-      line i ppf "Pfield \"%s\"\n" s;
-      core_type i ppf ct;
-  | Pfield_var -> line i ppf "Pfield_var\n";
-
 and pattern i ppf x =
   line i ppf "pattern %a\n" fmt_location x.ppat_loc;
+  attributes i ppf x.ppat_attributes;
   let i = i+1 in
   match x.ppat_desc with
   | Ppat_any -> line i ppf "Ppat_any\n";
@@ -187,18 +194,18 @@ and pattern i ppf x =
       line i ppf "Ppat_alias %a\n" fmt_string_loc s;
       pattern i ppf p;
   | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
+  | Ppat_interval (c1, c2) -> line i ppf "Ppat_interval %a..%a\n" fmt_constant c1 fmt_constant c2;
   | Ppat_tuple (l) ->
       line i ppf "Ppat_tuple\n";
       list i pattern ppf l;
-  | Ppat_construct (li, po, b) ->
+  | Ppat_construct (li, po) ->
       line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
       option i pattern ppf po;
-      bool i ppf b;
   | Ppat_variant (l, po) ->
       line i ppf "Ppat_variant \"%s\"\n" l;
       option i pattern ppf po;
   | Ppat_record (l, c) ->
-      line i ppf "Ppat_record\n";
+      line i ppf "Ppat_record %a\n" fmt_closed_flag c;
       list i longident_x_pattern ppf l;
   | Ppat_array (l) ->
       line i ppf "Ppat_array\n";
@@ -219,21 +226,29 @@ and pattern i ppf x =
       longident_loc i ppf li
   | Ppat_unpack s ->
       line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
+  | Ppat_extension (s, arg) ->
+      line i ppf "Ppat_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.pexp_loc;
+  attributes i ppf x.pexp_attributes;
   let i = i+1 in
   match x.pexp_desc with
   | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident_loc li;
   | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
   | Pexp_let (rf, l, e) ->
       line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l;
+      list i value_binding ppf l;
       expression i ppf e;
-  | Pexp_function (p, eo, l) ->
-      line i ppf "Pexp_function \"%s\"\n" p;
+  | Pexp_function l ->
+      line i ppf "Pexp_function\n";
+      list i case ppf l;
+  | Pexp_fun (l, eo, p, e) ->
+      line i ppf "Pexp_fun \"%s\"\n" l;
       option i expression ppf eo;
-      list i pattern_x_expression_case ppf l;
+      pattern i ppf p;
+      expression i ppf e;
   | Pexp_apply (e, l) ->
       line i ppf "Pexp_apply\n";
       expression i ppf e;
@@ -241,18 +256,17 @@ and expression i ppf x =
   | Pexp_match (e, l) ->
       line i ppf "Pexp_match\n";
       expression i ppf e;
-      list i pattern_x_expression_case ppf l;
+      list i case ppf l;
   | Pexp_try (e, l) ->
       line i ppf "Pexp_try\n";
       expression i ppf e;
-      list i pattern_x_expression_case ppf l;
+      list i case ppf l;
   | Pexp_tuple (l) ->
       line i ppf "Pexp_tuple\n";
       list i expression ppf l;
-  | Pexp_construct (li, eo, b) ->
+  | Pexp_construct (li, eo) ->
       line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
       option i expression ppf eo;
-      bool i ppf b;
   | Pexp_variant (l, eo) ->
       line i ppf "Pexp_variant \"%s\"\n" l;
       option i expression ppf eo;
@@ -290,15 +304,15 @@ and expression i ppf x =
       expression i ppf e1;
       expression i ppf e2;
       expression i ppf e3;
-  | Pexp_constraint (e, cto1, cto2) ->
+  | Pexp_constraint (e, ct) ->
       line i ppf "Pexp_constraint\n";
       expression i ppf e;
+      core_type i ppf ct;
+  | Pexp_coerce (e, cto1, cto2) ->
+      line i ppf "Pexp_coerce\n";
+      expression i ppf e;
       option i core_type ppf cto1;
-      option i core_type ppf cto2;
-  | Pexp_when (e1, e2) ->
-      line i ppf "Pexp_when\n";
-      expression i ppf e1;
-      expression i ppf e2;
+      core_type i ppf cto2;
   | Pexp_send (e, s) ->
       line i ppf "Pexp_send \"%s\"\n" s;
       expression i ppf e;
@@ -316,8 +330,6 @@ and expression i ppf x =
   | Pexp_assert (e) ->
       line i ppf "Pexp_assert\n";
       expression i ppf e;
-  | Pexp_assertfalse ->
-      line i ppf "Pexp_assertfalse\n";
   | Pexp_lazy (e) ->
       line i ppf "Pexp_lazy\n";
       expression i ppf e;
@@ -338,31 +350,55 @@ and expression i ppf x =
       line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf
         fmt_longident_loc m;
       expression i ppf e
+  | Pexp_extension (s, arg) ->
+      line i ppf "Pexp_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and value_description i ppf x =
-  line i ppf "value_description %a\n" fmt_location x.pval_loc;
+  line i ppf "value_description %a %a\n" fmt_string_loc x.pval_name fmt_location x.pval_loc;
+  attributes i ppf x.pval_attributes;
   core_type (i+1) ppf x.pval_type;
-  list (i+1) string ppf x.pval_prim;
+  list (i+1) string ppf x.pval_prim
 
-and string_option_underscore i ppf =
-  function
-    | Some x ->
-        string_loc i ppf x
-    | None ->
-        string i ppf "_"
+and type_parameter i ppf (x, _variance) =
+  match x with
+  | Some x ->
+      string_loc i ppf x
+  | None ->
+      string i ppf "_"
 
 and type_declaration i ppf x =
-  line i ppf "type_declaration %a\n" fmt_location x.ptype_loc;
+  line i ppf "type_declaration %a %a\n" fmt_string_loc x.ptype_name fmt_location x.ptype_loc;
+  attributes i ppf x.ptype_attributes;
   let i = i+1 in
   line i ppf "ptype_params =\n";
-  list (i+1) string_option_underscore ppf x.ptype_params;
+  list (i+1) type_parameter ppf x.ptype_params;
   line i ppf "ptype_cstrs =\n";
   list (i+1) core_type_x_core_type_x_location ppf x.ptype_cstrs;
   line i ppf "ptype_kind =\n";
   type_kind (i+1) ppf x.ptype_kind;
   line i ppf "ptype_private = %a\n" fmt_private_flag x.ptype_private;
   line i ppf "ptype_manifest =\n";
-  option (i+1) core_type ppf x.ptype_manifest;
+  option (i+1) core_type ppf x.ptype_manifest
+
+and attributes i ppf l =
+  let i = i + 1 in
+  List.iter
+    (fun (s, arg) ->
+      line i ppf "attribute \"%s\"\n" s.txt;
+      payload (i + 1) ppf arg;
+    )
+    l
+
+and payload i ppf = function
+  | PStr x -> structure i ppf x
+  | PTyp x -> core_type i ppf x
+  | PPat (x, None) -> pattern i ppf x
+  | PPat (x, Some g) ->
+    pattern i ppf x;
+    line i ppf "<when>\n";
+    expression (i + 1) ppf g
+
 
 and type_kind i ppf x =
   match x with
@@ -370,15 +406,14 @@ and type_kind i ppf x =
       line i ppf "Ptype_abstract\n"
   | Ptype_variant l ->
       line i ppf "Ptype_variant\n";
-      list (i+1) string_x_core_type_list_x_location ppf l;
+      list (i+1) constructor_decl ppf l;
   | Ptype_record l ->
       line i ppf "Ptype_record\n";
-      list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
-
-and exception_declaration i ppf x = list i core_type ppf x
+      list (i+1) label_decl ppf l;
 
 and class_type i ppf x =
   line i ppf "class_type %a\n" fmt_location x.pcty_loc;
+  attributes i ppf x.pcty_attributes;
   let i = i+1 in
   match x.pcty_desc with
   | Pcty_constr (li, l) ->
@@ -387,60 +422,67 @@ and class_type i ppf x =
   | Pcty_signature (cs) ->
       line i ppf "Pcty_signature\n";
       class_signature i ppf cs;
-  | Pcty_fun (l, co, cl) ->
-      line i ppf "Pcty_fun \"%s\"\n" l;
+  | Pcty_arrow (l, co, cl) ->
+      line i ppf "Pcty_arrow \"%s\"\n" l;
       core_type i ppf co;
       class_type i ppf cl;
+  | Pcty_extension (s, arg) ->
+      line i ppf "Pcty_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and class_signature i ppf cs =
-  line i ppf "class_signature %a\n" fmt_location cs.pcsig_loc;
+  line i ppf "class_signature\n";
   core_type (i+1) ppf cs.pcsig_self;
   list (i+1) class_type_field ppf cs.pcsig_fields;
 
 and class_type_field i ppf x =
   line i ppf "class_type_field %a\n" fmt_location x.pctf_loc;
   let i = i+1 in
+  attributes i ppf x.pctf_attributes;
   match x.pctf_desc with
-  | Pctf_inher (ct) ->
-      line i ppf "Pctf_inher\n";
+  | Pctf_inherit (ct) ->
+      line i ppf "Pctf_inherit\n";
       class_type i ppf ct;
   | Pctf_val (s, mf, vf, ct) ->
       line i ppf "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf
            fmt_virtual_flag vf;
       core_type (i+1) ppf ct;
-  | Pctf_virt (s, pf, ct) ->
-      line i ppf "Pctf_virt \"%s\" %a\n" s fmt_private_flag pf;
-      core_type (i+1) ppf ct;
-  | Pctf_meth (s, pf, ct) ->
-      line i ppf "Pctf_meth \"%s\" %a\n" s fmt_private_flag pf;
+  | Pctf_method (s, pf, vf, ct) ->
+      line i ppf "Pctf_method \"%s\" %a %a\n" s fmt_private_flag pf fmt_virtual_flag vf;
       core_type (i+1) ppf ct;
-  | Pctf_cstr (ct1, ct2) ->
-      line i ppf "Pctf_cstr\n";
+  | Pctf_constraint (ct1, ct2) ->
+      line i ppf "Pctf_constraint\n";
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
+  | Pctf_extension (s, arg) ->
+      line i ppf "Pctf_extension \"%s\"\n" s.txt;
+     payload i ppf arg
 
 and class_description i ppf x =
   line i ppf "class_description %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.pci_params;
+  cl_type_parameters (i+1) ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
 
 and class_type_declaration i ppf x =
   line i ppf "class_type_declaration %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.pci_params;
+  cl_type_parameters (i+1) ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
 
 and class_expr i ppf x =
   line i ppf "class_expr %a\n" fmt_location x.pcl_loc;
+  attributes i ppf x.pcl_attributes;
   let i = i+1 in
   match x.pcl_desc with
   | Pcl_constr (li, l) ->
@@ -461,14 +503,17 @@ and class_expr i ppf x =
       list i label_x_expression ppf l;
   | Pcl_let (rf, l, ce) ->
       line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l;
+      list i value_binding ppf l;
       class_expr i ppf ce;
   | Pcl_constraint (ce, ct) ->
       line i ppf "Pcl_constraint\n";
       class_expr i ppf ce;
       class_type i ppf ct;
+  | Pcl_extension (s, arg) ->
+      line i ppf "Pcl_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
-and class_structure i ppf { pcstr_pat = p; pcstr_fields = l } =
+and class_structure i ppf { pcstr_self = p; pcstr_fields = l } =
   line i ppf "class_structure\n";
   pattern (i+1) ppf p;
   list (i+1) class_field ppf l;
@@ -476,47 +521,53 @@ and class_structure i ppf { pcstr_pat = p; pcstr_fields = l } =
 and class_field i ppf x =
   line i ppf "class_field %a\n" fmt_location x.pcf_loc;
   let i = i + 1 in
+  attributes i ppf x.pcf_attributes;
   match x.pcf_desc with
-  | Pcf_inher (ovf, ce, so) ->
-      line i ppf "Pcf_inher %a\n" fmt_override_flag ovf;
+  | Pcf_inherit (ovf, ce, so) ->
+      line i ppf "Pcf_inherit %a\n" fmt_override_flag ovf;
       class_expr (i+1) ppf ce;
       option (i+1) string ppf so;
-  | Pcf_valvirt (s, mf, ct) ->
-      line i ppf "Pcf_valvirt %a\n" fmt_mutable_flag mf;
-      line (i+1) ppf "%a\n" fmt_string_loc s;
-      core_type (i+1) ppf ct;
-  | Pcf_val (s, mf, ovf, e) ->
-      line i ppf "Pcf_val %a %a\n" fmt_mutable_flag mf fmt_override_flag ovf;
+  | Pcf_val (s, mf, k) ->
+      line i ppf "Pcf_val %a\n" fmt_mutable_flag mf;
       line (i+1) ppf "%a\n" fmt_string_loc s;
-      expression (i+1) ppf e;
-  | Pcf_virt (s, pf, ct) ->
-      line i ppf "Pcf_virt %a\n" fmt_private_flag pf;
-      line (i+1) ppf "%a\n" fmt_string_loc s;
-      core_type (i+1) ppf ct;
-  | Pcf_meth (s, pf, ovf, e) ->
-      line i ppf "Pcf_meth %a %a\n" fmt_private_flag pf fmt_override_flag ovf;
+      class_field_kind (i+1) ppf k
+  | Pcf_method (s, pf, k) ->
+      line i ppf "Pcf_method %a\n" fmt_private_flag pf;
       line (i+1) ppf "%a\n" fmt_string_loc s;
-      expression (i+1) ppf e;
-  | Pcf_constr (ct1, ct2) ->
-      line i ppf "Pcf_constr\n";
+      class_field_kind (i+1) ppf k
+  | Pcf_constraint (ct1, ct2) ->
+      line i ppf "Pcf_constraint\n";
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
-  | Pcf_init (e) ->
-      line i ppf "Pcf_init\n";
+  | Pcf_initializer (e) ->
+      line i ppf "Pcf_initializer\n";
       expression (i+1) ppf e;
+  | Pcf_extension (s, arg) ->
+      line i ppf "Pcf_extension \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and class_field_kind i ppf = function
+  | Cfk_concrete (o, e) ->
+      line i ppf "Concrete %a\n" fmt_override_flag o;
+      expression i ppf e
+  | Cfk_virtual t ->
+      line i ppf "Virtual\n";
+      core_type i ppf t
 
 and class_declaration i ppf x =
   line i ppf "class_declaration %a\n" fmt_location x.pci_loc;
+  attributes i ppf x.pci_attributes;
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.pci_params;
+  cl_type_parameters (i+1) ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_expr (i+1) ppf x.pci_expr;
 
 and module_type i ppf x =
   line i ppf "module_type %a\n" fmt_location x.pmty_loc;
+  attributes i ppf x.pmty_attributes;
   let i = i+1 in
   match x.pmty_desc with
   | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li;
@@ -530,10 +581,13 @@ and module_type i ppf x =
   | Pmty_with (mt, l) ->
       line i ppf "Pmty_with\n";
       module_type i ppf mt;
-      list i longident_x_with_constraint ppf l;
+      list i with_constraint ppf l;
   | Pmty_typeof m ->
       line i ppf "Pmty_typeof\n";
       module_expr i ppf m;
+  | Pmty_extension (s, arg) ->
+      line i ppf "Pmod_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and signature i ppf x = list i signature_item ppf x
 
@@ -541,58 +595,73 @@ and signature_item i ppf x =
   line i ppf "signature_item %a\n" fmt_location x.psig_loc;
   let i = i+1 in
   match x.psig_desc with
-  | Psig_value (s, vd) ->
-      line i ppf "Psig_value %a\n" fmt_string_loc s;
+  | Psig_value vd ->
+      line i ppf "Psig_value\n";
       value_description i ppf vd;
   | Psig_type (l) ->
       line i ppf "Psig_type\n";
-      list i string_x_type_declaration ppf l;
-  | Psig_exception (s, ed) ->
-      line i ppf "Psig_exception %a\n" fmt_string_loc s;
-      exception_declaration i ppf ed;
-  | Psig_module (s, mt) ->
-      line i ppf "Psig_module %a\n" fmt_string_loc s;
-      module_type i ppf mt;
+      list i type_declaration ppf l;
+  | Psig_exception cd ->
+      line i ppf "Psig_exception\n";
+      constructor_decl i ppf cd;
+  | Psig_module pmd ->
+      line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name;
+      attributes i ppf pmd.pmd_attributes;
+      module_type i ppf pmd.pmd_type
   | Psig_recmodule decls ->
       line i ppf "Psig_recmodule\n";
-      list i string_x_module_type ppf decls;
-  | Psig_modtype (s, md) ->
-      line i ppf "Psig_modtype %a\n" fmt_string_loc s;
-      modtype_declaration i ppf md;
-  | Psig_open (ovf, li) ->
-    line i ppf "Psig_open %a %a\n"
-      fmt_override_flag ovf
-      fmt_longident_loc li;
-  | Psig_include (mt) ->
+      list i module_declaration ppf decls;
+  | Psig_modtype x ->
+      line i ppf "Psig_modtype %a\n" fmt_string_loc x.pmtd_name;
+      attributes i ppf x.pmtd_attributes;
+      modtype_declaration i ppf x.pmtd_type
+  | Psig_open (ovf, li, attrs) ->
+      line i ppf "Psig_open %a %a\n"
+        fmt_override_flag ovf
+        fmt_longident_loc li;
+      attributes i ppf attrs
+  | Psig_include (mt, attrs) ->
       line i ppf "Psig_include\n";
       module_type i ppf mt;
+      attributes i ppf attrs
   | Psig_class (l) ->
       line i ppf "Psig_class\n";
       list i class_description ppf l;
   | Psig_class_type (l) ->
       line i ppf "Psig_class_type\n";
       list i class_type_declaration ppf l;
-
-and modtype_declaration i ppf x =
-  match x with
-  | Pmodtype_abstract -> line i ppf "Pmodtype_abstract\n";
-  | Pmodtype_manifest (mt) ->
-      line i ppf "Pmodtype_manifest\n";
-      module_type (i+1) ppf mt;
+  | Psig_extension ((s, arg), attrs) ->
+      line i ppf "Psig_extension \"%s\"\n" s.txt;
+      attributes i ppf attrs;
+      payload i ppf arg
+  | Psig_attribute (s, arg) ->
+      line i ppf "Psig_attribute \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and modtype_declaration i ppf = function
+  | None -> line i ppf "#abstract"
+  | Some mt -> module_type (i+1) ppf mt
 
 and with_constraint i ppf x =
   match x with
-  | Pwith_type (td) ->
-      line i ppf "Pwith_type\n";
+  | Pwith_type (lid, td) ->
+      line i ppf "Pwith_type %a\n" fmt_longident_loc lid;
       type_declaration (i+1) ppf td;
   | Pwith_typesubst (td) ->
       line i ppf "Pwith_typesubst\n";
       type_declaration (i+1) ppf td;
-  | Pwith_module li -> line i ppf "Pwith_module %a\n" fmt_longident_loc li;
-  | Pwith_modsubst li -> line i ppf "Pwith_modsubst %a\n" fmt_longident_loc li;
+  | Pwith_module (lid1, lid2) ->
+      line i ppf "Pwith_module %a = %a\n"
+        fmt_longident_loc lid1
+        fmt_longident_loc lid2;
+  | Pwith_modsubst (s, li) ->
+      line i ppf "Pwith_modsubst %a = %a\n"
+        fmt_string_loc s
+        fmt_longident_loc li;
 
 and module_expr i ppf x =
   line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
+  attributes i ppf x.pmod_attributes;
   let i = i+1 in
   match x.pmod_desc with
   | Pmod_ident (li) -> line i ppf "Pmod_ident %a\n" fmt_longident_loc li;
@@ -614,6 +683,9 @@ and module_expr i ppf x =
   | Pmod_unpack (e) ->
       line i ppf "Pmod_unpack\n";
       expression i ppf e;
+  | Pmod_extension (s, arg) ->
+      line i ppf "Pmod_extension \"%s\"\n" s.txt;
+      payload i ppf arg
 
 and structure i ppf x = list i structure_item ppf x
 
@@ -621,99 +693,114 @@ and structure_item i ppf x =
   line i ppf "structure_item %a\n" fmt_location x.pstr_loc;
   let i = i+1 in
   match x.pstr_desc with
-  | Pstr_eval (e) ->
+  | Pstr_eval (e, attrs) ->
       line i ppf "Pstr_eval\n";
+      attributes i ppf attrs;
       expression i ppf e;
   | Pstr_value (rf, l) ->
       line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l;
-  | Pstr_primitive (s, vd) ->
-      line i ppf "Pstr_primitive %a\n" fmt_string_loc s;
+      list i value_binding ppf l;
+  | Pstr_primitive vd ->
+      line i ppf "Pstr_primitive\n";
       value_description i ppf vd;
   | Pstr_type l ->
       line i ppf "Pstr_type\n";
-      list i string_x_type_declaration ppf l;
-  | Pstr_exception (s, ed) ->
-      line i ppf "Pstr_exception %a\n" fmt_string_loc s;
-      exception_declaration i ppf ed;
-  | Pstr_exn_rebind (s, li) ->
+      list i type_declaration ppf l;
+  | Pstr_exception cd ->
+      line i ppf "Pstr_exception\n";
+      constructor_decl i ppf cd;
+  | Pstr_exn_rebind (s, li, attrs) ->
       line i ppf "Pstr_exn_rebind\n";
+      attributes i ppf attrs;
       line (i+1) ppf "%a\n" fmt_string_loc s;
-      line (i+1) ppf "%a\n" fmt_longident_loc li;
-  | Pstr_module (s, me) ->
-      line i ppf "Pstr_module %a\n" fmt_string_loc s;
-      module_expr i ppf me;
+      line (i+1) ppf "%a\n" fmt_longident_loc li
+  | Pstr_module x ->
+      line i ppf "Pstr_module\n";
+      module_binding i ppf x
   | Pstr_recmodule bindings ->
       line i ppf "Pstr_recmodule\n";
-      list i string_x_modtype_x_module ppf bindings;
-  | Pstr_modtype (s, mt) ->
-      line i ppf "Pstr_modtype %a\n" fmt_string_loc s;
-      module_type i ppf mt;
-  | Pstr_open (ovf, li) ->
-    line i ppf "Pstr_open %a %a\n"
-      fmt_override_flag ovf
-      fmt_longident_loc li;
+      list i module_binding ppf bindings;
+  | Pstr_modtype x ->
+      line i ppf "Pstr_modtype %a\n" fmt_string_loc x.pmtd_name;
+      attributes i ppf x.pmtd_attributes;
+      modtype_declaration i ppf x.pmtd_type
+  | Pstr_open (ovf, li, attrs) ->
+      line i ppf "Pstr_open %a %a\n"
+        fmt_override_flag ovf
+        fmt_longident_loc li;
+      attributes i ppf attrs
   | Pstr_class (l) ->
       line i ppf "Pstr_class\n";
       list i class_declaration ppf l;
   | Pstr_class_type (l) ->
       line i ppf "Pstr_class_type\n";
       list i class_type_declaration ppf l;
-  | Pstr_include me ->
+  | Pstr_include (me, attrs) ->
       line i ppf "Pstr_include";
+      attributes i ppf attrs;
       module_expr i ppf me
-
-and string_x_type_declaration i ppf (s, td) =
-  string_loc i ppf s;
-  type_declaration (i+1) ppf td;
-
-and string_x_module_type i ppf (s, mty) =
-  string_loc i ppf s;
-  module_type (i+1) ppf mty;
-
-and string_x_modtype_x_module i ppf (s, mty, modl) =
-  string_loc i ppf s;
-  module_type (i+1) ppf mty;
-  module_expr (i+1) ppf modl;
-
-and longident_x_with_constraint i ppf (li, wc) =
-  line i ppf "%a\n" fmt_longident_loc li;
-  with_constraint (i+1) ppf wc;
+  | Pstr_extension ((s, arg), attrs) ->
+      line i ppf "Pstr_extension \"%s\"\n" s.txt;
+      attributes i ppf attrs;
+      payload i ppf arg
+  | Pstr_attribute (s, arg) ->
+      line i ppf "Pstr_attribute \"%s\"\n" s.txt;
+      payload i ppf arg
+
+and module_declaration i ppf pmd =
+  string_loc i ppf pmd.pmd_name;
+  attributes i ppf pmd.pmd_attributes;
+  module_type (i+1) ppf pmd.pmd_type;
+
+and module_binding i ppf x =
+  string_loc i ppf x.pmb_name;
+  attributes i ppf x.pmb_attributes;
+  module_expr (i+1) ppf x.pmb_expr
 
 and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
   line i ppf "<constraint> %a\n" fmt_location l;
   core_type (i+1) ppf ct1;
   core_type (i+1) ppf ct2;
 
-and string_x_core_type_list_x_location i ppf (s, l, r_opt, loc) =
-  line i ppf "%a\n" fmt_location loc;
-  line (i+1) ppf "%a\n" fmt_string_loc s;
-  list (i+1) core_type ppf l;
-  option (i+1) core_type ppf r_opt;
+and constructor_decl i ppf {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
+  line i ppf "%a\n" fmt_location pcd_loc;
+  attributes i ppf pcd_attributes;
+  line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
+  list (i+1) core_type ppf pcd_args;
+  option (i+1) core_type ppf pcd_res
 
-and string_x_mutable_flag_x_core_type_x_location i ppf (s, mf, ct, loc) =
-  line i ppf "%a\n" fmt_location loc;
-  line (i+1) ppf "%a\n" fmt_mutable_flag mf;
-  line (i+1) ppf "%a" fmt_string_loc s;
-  core_type (i+1) ppf ct;
+and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes} =
+  line i ppf "%a\n" fmt_location pld_loc;
+  attributes i ppf pld_attributes;
+  line (i+1) ppf "%a\n" fmt_mutable_flag pld_mutable;
+  line (i+1) ppf "%a" fmt_string_loc pld_name;
+  core_type (i+1) ppf pld_type
 
-and string_list_x_location i ppf (l, loc) =
-  line i ppf "<params> %a\n" fmt_location loc;
-  list (i+1) string_loc ppf l;
+and cl_type_parameters i ppf l =
+  line i ppf "<params>\n";
+  list (i+1) cl_type_parameter ppf l;
+
+and cl_type_parameter i ppf (x, _variance) =
+  string_loc i ppf x
 
 and longident_x_pattern i ppf (li, p) =
   line i ppf "%a\n" fmt_longident_loc li;
   pattern (i+1) ppf p;
 
-and pattern_x_expression_case i ppf (p, e) =
+and case i ppf {pc_lhs; pc_guard; pc_rhs} =
   line i ppf "<case>\n";
-  pattern (i+1) ppf  p;
-  expression (i+1) ppf e;
-
-and pattern_x_expression_def i ppf (p, e) =
+  pattern (i+1) ppf pc_lhs;
+  begin match pc_guard with
+  | None -> ()
+  | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
+  end;
+  expression (i+1) ppf pc_rhs;
+
+and value_binding i ppf x =
   line i ppf "<def>\n";
-  pattern (i+1) ppf p;
-  expression (i+1) ppf e;
+  attributes (i+1) ppf x.pvb_attributes;
+  pattern (i+1) ppf x.pvb_pat;
+  expression (i+1) ppf x.pvb_expr
 
 and string_x_expression i ppf (s, e) =
   line i ppf "<override> %a\n" fmt_string_loc s;
diff --git a/parsing/printast.mli b/parsing/printast.mli
index a941da9e4..8523e71c9 100644
--- a/parsing/printast.mli
+++ b/parsing/printast.mli
@@ -16,3 +16,7 @@ open Format;;
 val interface : formatter -> signature_item list -> unit;;
 val implementation : formatter -> structure_item list -> unit;;
 val top_phrase : formatter -> toplevel_phrase -> unit;;
+
+val expression: int -> formatter -> expression -> unit
+val structure: int -> formatter -> structure -> unit
+val payload: int -> formatter -> payload -> unit
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
index 5c17a99a3..b19a382d4 100644
--- a/parsing/syntaxerr.ml
+++ b/parsing/syntaxerr.ml
@@ -17,6 +17,7 @@ open Format
 type error =
     Unclosed of Location.t * string * Location.t * string
   | Expecting of Location.t * string
+  | Not_expecting of Location.t * string
   | Applicative_path of Location.t
   | Variable_in_scope of Location.t * string
   | Other of Location.t
@@ -42,6 +43,10 @@ let report_error ppf = function
       fprintf ppf
         "%a@[Syntax error: %s expected.@]"
         Location.print_error loc nonterm
+  | Not_expecting (loc, nonterm) ->
+      fprintf ppf
+        "%a@[Syntax error: %s not expected.@]"
+        Location.print_error loc nonterm
   | Applicative_path loc ->
       fprintf ppf
         "%aSyntax error: applicative paths of the form F(X).t \
@@ -61,4 +66,5 @@ let location_of_error = function
   | Applicative_path l
   | Variable_in_scope(l,_)
   | Other l
+  | Not_expecting (l, _)
   | Expecting (l, _) -> l
diff --git a/parsing/syntaxerr.mli b/parsing/syntaxerr.mli
index 03cf532eb..0bacb0f95 100644
--- a/parsing/syntaxerr.mli
+++ b/parsing/syntaxerr.mli
@@ -17,6 +17,7 @@ open Format
 type error =
     Unclosed of Location.t * string * Location.t * string
   | Expecting of Location.t * string
+  | Not_expecting of Location.t * string
   | Applicative_path of Location.t
   | Variable_in_scope of Location.t * string
   | Other of Location.t
diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile
index fd01d3368..d0752351a 100644
--- a/testsuite/tests/asmcomp/Makefile
+++ b/testsuite/tests/asmcomp/Makefile
@@ -33,6 +33,7 @@ OTHEROBJS=\
   $(OTOPDIR)/parsing/location.cmo \
   $(OTOPDIR)/parsing/longident.cmo \
   $(OTOPDIR)/parsing/syntaxerr.cmo \
+  $(OTOPDIR)/parsing/ast_helper.cmo \
   $(OTOPDIR)/parsing/parser.cmo \
   $(OTOPDIR)/parsing/lexer.cmo \
   $(OTOPDIR)/parsing/parse.cmo \
diff --git a/tools/.depend b/tools/.depend
index 9b20d32f9..bc45dc761 100644
--- a/tools/.depend
+++ b/tools/.depend
@@ -27,6 +27,14 @@ depend.cmo : ../parsing/parsetree.cmi ../utils/misc.cmi \
 depend.cmx : ../parsing/parsetree.cmi ../utils/misc.cmx \
     ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi \
     depend.cmi
+dump_ast.cmo : ../typing/typetexp.cmi ../typing/typedtree.cmi \
+    ../toplevel/toploop.cmi ../parsing/parse.cmi ../typing/outcometree.cmi \
+    ../typing/oprint.cmi ../driver/errors.cmi ../typing/env.cmi \
+    ../utils/config.cmi
+dump_ast.cmx : ../typing/typetexp.cmx ../typing/typedtree.cmx \
+    ../toplevel/toploop.cmx ../parsing/parse.cmx ../typing/outcometree.cmi \
+    ../typing/oprint.cmx ../driver/errors.cmx ../typing/env.cmx \
+    ../utils/config.cmx
 dumpobj.cmo : ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \
     ../utils/misc.cmi ../parsing/location.cmi ../bytecomp/lambda.cmi \
     ../bytecomp/instruct.cmi ../typing/ident.cmi ../utils/config.cmi \
diff --git a/tools/Makefile.shared b/tools/Makefile.shared
index 117f57682..9dea8448c 100644
--- a/tools/Makefile.shared
+++ b/tools/Makefile.shared
@@ -17,18 +17,20 @@ CAMLC=$(CAMLRUN) ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
 CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib
 CAMLLEX=$(CAMLRUN) ../boot/ocamllex
 INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
-	 -I ../driver
+	 -I ../driver -I ../toplevel
 COMPFLAGS= -w +32..39 -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 
 all: ocamldep ocamlprof ocamlcp ocamloptp ocamlmktop ocamlmklib dumpobj \
      objinfo read_cmt
 
+moretools: ocamlast
+
 all: tast_iter.cmo
 
 # scrapelabels addlabels
 
-.PHONY: all
+.PHONY: all moretools
 
 opt.opt: ocamldep.opt read_cmt.opt
 .PHONY: opt.opt
@@ -38,7 +40,7 @@ opt.opt: ocamldep.opt read_cmt.opt
 CAMLDEP_OBJ=depend.cmo ocamldep.cmo
 CAMLDEP_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo \
-  syntaxerr.cmo parser.cmo lexer.cmo parse.cmo \
+  syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
   ccomp.cmo pparse.cmo compenv.cmo
 
 ocamldep: depend.cmi $(CAMLDEP_OBJ)
@@ -64,7 +66,7 @@ install::
 CSLPROF=ocamlprof.cmo
 CSLPROF_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo \
-  syntaxerr.cmo parser.cmo lexer.cmo parse.cmo
+  syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo
 
 ocamlprof: $(CSLPROF) profiling.cmo
 	$(CAMLC) $(LINKFLAGS) -o ocamlprof $(CSLPROF_IMPORTS) $(CSLPROF)
@@ -165,7 +167,7 @@ clean::
 
 ADDLABELS_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo \
-  syntaxerr.cmo parser.cmo lexer.cmo parse.cmo
+  syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo
 
 addlabels: addlabels.cmo
 	$(CAMLC) $(LINKFLAGS) -w sl -o addlabels \
@@ -211,6 +213,7 @@ READ_CMT= \
           ../parsing/longident.cmo \
           ../parsing/lexer.cmo \
           ../parsing/pprintast.cmo \
+          ../parsing/ast_helper.cmo \
           ../typing/ident.cmo \
           ../typing/path.cmo \
           ../typing/types.cmo \
@@ -307,6 +310,19 @@ primreq: $(PRIMREQ)
 clean::
 	rm -f primreq
 
+# Dump the Parsetree representation of OCaml code, in OCaml syntax
+
+OCAMLAST=dump_ast.cmo
+
+ocamlast: $(OCAMLAST)
+	$(CAMLC) $(LINKFLAGS) -o ocamlast ../compilerlibs/ocamlcommon.cma ../compilerlibs/ocamlbytecomp.cma ../compilerlibs/ocamltoplevel.cma $(OCAMLAST)
+
+clean::
+	rm -rf ocamlast
+
+install::
+	cp ocamlast $(BINDIR)/ocamlast$(EXE)
+
 # Common stuff
 
 .SUFFIXES:
diff --git a/tools/addlabels.ml b/tools/addlabels.ml
index 01dbe2cbe..37e5625fe 100644
--- a/tools/addlabels.ml
+++ b/tools/addlabels.ml
@@ -44,7 +44,7 @@ let rec labels_of_sty sty =
 
 let rec labels_of_cty cty =
   match cty.pcty_desc with
-    Pcty_fun (lab, _, rem) ->
+    Pcty_arrow (lab, _, rem) ->
       let (labs, meths) = labels_of_cty rem in
       (lab :: labs, meths)
   | Pcty_signature { pcsig_fields = fields } ->
@@ -65,7 +65,7 @@ let rec pattern_vars pat =
   | Ppat_tuple l
   | Ppat_array l ->
       List.concat (List.map pattern_vars l)
-  | Ppat_construct (_, Some pat, _)
+  | Ppat_construct (_, Some pat)
   | Ppat_variant (_, Some pat)
   | Ppat_constraint (pat, _) ->
       pattern_vars pat
@@ -260,7 +260,7 @@ let rec add_labels_expr ~text ~values ~classes expr =
       List.iter add_labels_rec (e :: List.map snd args)
   | Pexp_tuple l | Pexp_array l ->
       List.iter add_labels_rec l
-  | Pexp_construct (_, Some e, _)
+  | Pexp_construct (_, Some e)
   | Pexp_variant (_, Some e)
   | Pexp_field (e, _)
   | Pexp_constraint (e, _, _)
@@ -290,13 +290,13 @@ let rec add_labels_expr ~text ~values ~classes expr =
   | Pexp_override lst ->
       List.iter lst ~f:(fun (_,e) -> add_labels_rec e)
   | Pexp_ident _ | Pexp_constant _ | Pexp_construct _ | Pexp_variant _
-  | Pexp_new _ | Pexp_assertfalse | Pexp_object _ | Pexp_pack _ ->
+  | Pexp_new _ | Pexp_object _ | Pexp_pack _ ->
       ()
 
 let rec add_labels_class ~text ~classes ~values ~methods cl =
   match cl.pcl_desc with
     Pcl_constr _ -> ()
-  | Pcl_structure { pcstr_pat = p; pcstr_fields = l } ->
+  | Pcl_structure { pcstr_self = p; pcstr_fields = l } ->
       let values = SMap.removes (pattern_vars p) values in
       let values =
         match pattern_name p with None -> values
diff --git a/tools/cmt2annot.ml b/tools/cmt2annot.ml
index 9632e48b5..82ac683da 100644
--- a/tools/cmt2annot.ml
+++ b/tools/cmt2annot.ml
@@ -29,10 +29,18 @@ let bind_variables scope =
 
 let bind_bindings scope bindings =
   let o = bind_variables scope in
-  List.iter (fun (p, _) -> o # pattern p) bindings
+  List.iter (fun x -> o # pattern x.vb_pat) bindings
 
 let bind_cases l =
-  List.iter (fun (p, e) -> (bind_variables e.exp_loc) # pattern p) l
+  List.iter
+    (fun {c_lhs; c_guard; c_rhs} ->
+      let loc =
+        let open Location in
+        match c_guard with
+        | None -> c_rhs.exp_loc
+        | Some g -> {c_rhs.exp_loc with loc_start=g.exp_loc.loc_start}
+      in
+      (bind_variables loc) # pattern c_lhs) l
 
 let iterator rebuild_env =
   object(this)
@@ -96,7 +104,6 @@ let iterator rebuild_env =
           let open Location in
           let doit loc_start = bind_bindings {scope with loc_start} bindings in
           begin match rec_flag, rem with
-          | Default, _ -> ()
           | Recursive, _ -> doit loc.loc_start
           | Nonrecursive, [] -> doit loc.loc_end
           | Nonrecursive,  {str_loc = loc2} :: _ -> doit loc2.loc_start
diff --git a/tools/depend.ml b/tools/depend.ml
index 31edfc97b..a59152cb6 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -43,8 +43,8 @@ let rec add_type bv ty =
   | Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
   | Ptyp_tuple tl -> List.iter (add_type bv) tl
   | Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
-  | Ptyp_object fl -> List.iter (add_field_type bv) fl
-  | Ptyp_class(c, tl, _) -> add bv c; List.iter (add_type bv) tl
+  | Ptyp_object (fl, _) -> List.iter (fun (_, t) -> add_type bv t) fl
+  | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
   | Ptyp_alias(t, s) -> add_type bv t
   | Ptyp_variant(fl, _, _) ->
       List.iter
@@ -53,20 +53,19 @@ let rec add_type bv ty =
         fl
   | Ptyp_poly(_, t) -> add_type bv t
   | Ptyp_package pt -> add_package_type bv pt
+  | Ptyp_extension _ -> ()
 
 and add_package_type bv (lid, l) =
   add bv lid;
   List.iter (add_type bv) (List.map (fun (_, e) -> e) l)
 
-and add_field_type bv ft =
-  match ft.pfield_desc with
-    Pfield(name, ty) -> add_type bv ty
-  | Pfield_var -> ()
-
 let add_opt add_fn bv = function
     None -> ()
   | Some x -> add_fn bv x
 
+let add_constructor_decl bv pcd =
+  List.iter (add_type bv) pcd.pcd_args; Misc.may (add_type bv) pcd.pcd_res
+
 let add_type_declaration bv td =
   List.iter
     (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2)
@@ -75,9 +74,9 @@ let add_type_declaration bv td =
   let add_tkind = function
     Ptype_abstract -> ()
   | Ptype_variant cstrs ->
-      List.iter (fun (c, args, rty, _) -> List.iter (add_type bv) args; Misc.may (add_type bv) rty) cstrs
+      List.iter (add_constructor_decl bv) cstrs
   | Ptype_record lbls ->
-      List.iter (fun (l, mut, ty, _) -> add_type bv ty) lbls in
+      List.iter (fun pld -> add_type bv pld.pld_type) lbls in
   add_tkind td.ptype_kind
 
 let rec add_class_type bv cty =
@@ -87,16 +86,17 @@ let rec add_class_type bv cty =
   | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
       add_type bv ty;
       List.iter (add_class_type_field bv) fieldl
-  | Pcty_fun(_, ty1, cty2) ->
+  | Pcty_arrow(_, ty1, cty2) ->
       add_type bv ty1; add_class_type bv cty2
+  | Pcty_extension _ -> ()
 
 and add_class_type_field bv pctf =
   match pctf.pctf_desc with
-    Pctf_inher cty -> add_class_type bv cty
+    Pctf_inherit cty -> add_class_type bv cty
   | Pctf_val(_, _, _, ty) -> add_type bv ty
-  | Pctf_virt(_, _, ty) -> add_type bv ty
-  | Pctf_meth(_, _, ty) -> add_type bv ty
-  | Pctf_cstr(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pctf_method(_, _, _, ty) -> add_type bv ty
+  | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pctf_extension _ -> ()
 
 let add_class_description bv infos =
   add_class_type bv infos.pci_expr
@@ -110,9 +110,10 @@ let rec add_pattern bv pat =
     Ppat_any -> ()
   | Ppat_var _ -> ()
   | Ppat_alias(p, _) -> add_pattern bv p
+  | Ppat_interval _
   | Ppat_constant _ -> ()
   | Ppat_tuple pl -> List.iter (add_pattern bv) pl
-  | Ppat_construct(c, op, _) -> add bv c; add_opt add_pattern bv op
+  | Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op
   | Ppat_record(pl, _) ->
       List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl
   | Ppat_array pl -> List.iter (add_pattern bv) pl
@@ -122,6 +123,7 @@ let rec add_pattern bv pat =
   | Ppat_type li -> add bv li
   | Ppat_lazy p -> add_pattern bv p
   | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+  | Ppat_extension _ -> ()
 
 let add_pattern bv pat =
   pattern_bv := bv;
@@ -134,14 +136,16 @@ let rec add_expr bv exp =
   | Pexp_constant _ -> ()
   | Pexp_let(rf, pel, e) ->
       let bv = add_bindings rf bv pel in add_expr bv e
-  | Pexp_function (_, opte, pel) ->
-      add_opt add_expr bv opte; add_pat_expr_list bv pel
+  | Pexp_fun (_, opte, p, e) ->
+      add_opt add_expr bv opte; add_expr (add_pattern bv p) e
+  | Pexp_function pel ->
+      add_cases bv pel
   | Pexp_apply(e, el) ->
       add_expr bv e; List.iter (fun (_,e) -> add_expr bv e) el
-  | Pexp_match(e, pel) -> add_expr bv e; add_pat_expr_list bv pel
-  | Pexp_try(e, pel) -> add_expr bv e; add_pat_expr_list bv pel
+  | Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel
+  | Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel
   | Pexp_tuple el -> List.iter (add_expr bv) el
-  | Pexp_construct(c, opte, _) -> add bv c; add_opt add_expr bv opte
+  | Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte
   | Pexp_variant(_, opte) -> add_opt add_expr bv opte
   | Pexp_record(lblel, opte) ->
       List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel;
@@ -155,11 +159,13 @@ let rec add_expr bv exp =
   | Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2
   | Pexp_for( _, e1, e2, _, e3) ->
       add_expr bv e1; add_expr bv e2; add_expr bv e3
-  | Pexp_constraint(e1, oty2, oty3) ->
+  | Pexp_coerce(e1, oty2, ty3) ->
       add_expr bv e1;
       add_opt add_type bv oty2;
-      add_opt add_type bv oty3
-  | Pexp_when(e1, e2) -> add_expr bv e1; add_expr bv e2
+      add_type bv ty3
+  | Pexp_constraint(e1, ty2) ->
+      add_expr bv e1;
+      add_type bv ty2
   | Pexp_send(e, m) -> add_expr bv e
   | Pexp_new li -> add bv li
   | Pexp_setinstvar(v, e) -> add_expr bv e
@@ -167,22 +173,27 @@ let rec add_expr bv exp =
   | Pexp_letmodule(id, m, e) ->
       add_module bv m; add_expr (StringSet.add id.txt bv) e
   | Pexp_assert (e) -> add_expr bv e
-  | Pexp_assertfalse -> ()
   | Pexp_lazy (e) -> add_expr bv e
   | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
-  | Pexp_object { pcstr_pat = pat; pcstr_fields = fieldl } ->
+  | Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } ->
       let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pexp_newtype (_, e) -> add_expr bv e
   | Pexp_pack m -> add_module bv m
   | Pexp_open (_ovf, m, e) -> addmodule bv m; add_expr bv e
+  | Pexp_extension _ -> ()
 
-and add_pat_expr_list bv pel =
-  List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel
+and add_cases bv cases =
+  List.iter (add_case bv) cases
+
+and add_case bv {pc_lhs; pc_guard; pc_rhs} =
+  let bv = add_pattern bv pc_lhs in
+  add_opt add_expr bv pc_guard;
+  add_expr bv pc_rhs
 
 and add_bindings recf bv pel =
-  let bv' = List.fold_left (fun bv (p, _) -> add_pattern bv p) bv pel in
+  let bv' = List.fold_left (fun bv x -> add_pattern bv x.pvb_pat) bv pel in
   let bv = if recf = Recursive then bv' else bv in
-  List.iter (fun (_, e) -> add_expr bv e) pel;
+  List.iter (fun x -> add_expr bv x.pvb_expr) pel;
   bv'
 
 and add_modtype bv mty =
@@ -194,12 +205,15 @@ and add_modtype bv mty =
   | Pmty_with(mty, cstrl) ->
       add_modtype bv mty;
       List.iter
-        (function (_, Pwith_type td) -> add_type_declaration bv td
-                | (_, Pwith_module (lid)) -> addmodule bv lid
-                | (_, Pwith_typesubst td) -> add_type_declaration bv td
-                | (_, Pwith_modsubst (lid)) -> addmodule bv lid)
+        (function
+          | Pwith_type (_, td) -> add_type_declaration bv td
+          | Pwith_module (_, lid) -> addmodule bv lid
+          | Pwith_typesubst td -> add_type_declaration bv td
+          | Pwith_modsubst (_, lid) -> addmodule bv lid
+        )
         cstrl
   | Pmty_typeof m -> add_module bv m
+  | Pmty_extension _ -> ()
 
 and add_signature bv = function
     [] -> ()
@@ -207,32 +221,34 @@ and add_signature bv = function
 
 and add_sig_item bv item =
   match item.psig_desc with
-    Psig_value(id, vd) ->
+    Psig_value vd ->
       add_type bv vd.pval_type; bv
   | Psig_type dcls ->
-      List.iter (fun (id, td) -> add_type_declaration bv td) dcls; bv
-  | Psig_exception(id, args) ->
-      List.iter (add_type bv) args; bv
-  | Psig_module(id, mty) ->
-      add_modtype bv mty; StringSet.add id.txt bv
+      List.iter (add_type_declaration bv) dcls; bv
+  | Psig_exception pcd ->
+      add_constructor_decl bv pcd; bv
+  | Psig_module pmd ->
+      add_modtype bv pmd.pmd_type; StringSet.add pmd.pmd_name.txt bv
   | Psig_recmodule decls ->
-      let bv' = List.fold_right StringSet.add (List.map (fun (x,_) -> x.txt) decls) bv in
-      List.iter (fun (id, mty) -> add_modtype bv' mty) decls;
+      let bv' = List.fold_right StringSet.add (List.map (fun pmd -> pmd.pmd_name.txt) decls) bv in
+      List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
       bv'
-  | Psig_modtype(id,mtyd) ->
-      begin match mtyd with
-        Pmodtype_abstract -> ()
-      | Pmodtype_manifest mty -> add_modtype bv mty
+  | Psig_modtype x ->
+      begin match x.pmtd_type with
+        None -> ()
+      | Some mty -> add_modtype bv mty
       end;
       bv
-  | Psig_open (_ovf, lid) ->
+  | Psig_open (_ovf, lid, _) ->
       addmodule bv lid; bv
-  | Psig_include mty ->
+  | Psig_include (mty, _) ->
       add_modtype bv mty; bv
   | Psig_class cdl ->
       List.iter (add_class_description bv) cdl; bv
   | Psig_class_type cdtl ->
       List.iter (add_class_type_declaration bv) cdtl; bv
+  | Psig_attribute _ | Psig_extension _ ->
+      bv
 
 and add_module bv modl =
   match modl.pmod_desc with
@@ -247,44 +263,52 @@ and add_module bv modl =
       add_module bv modl; add_modtype bv mty
   | Pmod_unpack(e) ->
       add_expr bv e
+  | Pmod_extension _ ->
+      ()
 
 and add_structure bv item_list =
   List.fold_left add_struct_item bv item_list
 
 and add_struct_item bv item =
   match item.pstr_desc with
-    Pstr_eval e ->
+    Pstr_eval (e, _attrs) ->
       add_expr bv e; bv
   | Pstr_value(rf, pel) ->
       let bv = add_bindings rf bv pel in bv
-  | Pstr_primitive(id, vd) ->
+  | Pstr_primitive vd ->
       add_type bv vd.pval_type; bv
   | Pstr_type dcls ->
-      List.iter (fun (id, td) -> add_type_declaration bv td) dcls; bv
-  | Pstr_exception(id, args) ->
-      List.iter (add_type bv) args; bv
-  | Pstr_exn_rebind(id, l) ->
+      List.iter (add_type_declaration bv) dcls; bv
+  | Pstr_exception pcd ->
+      add_constructor_decl bv pcd; bv
+  | Pstr_exn_rebind(id, l, _attrs) ->
       add bv l; bv
-  | Pstr_module(id, modl) ->
-      add_module bv modl; StringSet.add id.txt bv
+  | Pstr_module x ->
+      add_module bv x.pmb_expr; StringSet.add x.pmb_name.txt bv
   | Pstr_recmodule bindings ->
       let bv' =
         List.fold_right StringSet.add
-          (List.map (fun (id,_,_) -> id.txt) bindings) bv in
+          (List.map (fun x -> x.pmb_name.txt) bindings) bv in
       List.iter
-        (fun (id, mty, modl) -> add_modtype bv' mty; add_module bv' modl)
+        (fun x -> add_module bv' x.pmb_expr)
         bindings;
       bv'
-  | Pstr_modtype(id, mty) ->
-      add_modtype bv mty; bv
-  | Pstr_open (_ovf, l) ->
+  | Pstr_modtype x ->
+      begin match x.pmtd_type with
+        None -> ()
+      | Some mty -> add_modtype bv mty
+      end;
+      bv
+  | Pstr_open (_ovf, l, _attrs) ->
       addmodule bv l; bv
   | Pstr_class cdl ->
       List.iter (add_class_declaration bv) cdl; bv
   | Pstr_class_type cdtl ->
       List.iter (add_class_type_declaration bv) cdtl; bv
-  | Pstr_include modl ->
+  | Pstr_include (modl, _attrs) ->
       add_module bv modl; bv
+  | Pstr_attribute _ | Pstr_extension _ ->
+      bv
 
 and add_use_file bv top_phrs =
   ignore (List.fold_left add_top_phrase bv top_phrs)
@@ -300,7 +324,7 @@ and add_class_expr bv ce =
   match ce.pcl_desc with
     Pcl_constr(l, tyl) ->
       add bv l; List.iter (add_type bv) tyl
-  | Pcl_structure { pcstr_pat = pat; pcstr_fields = fieldl } ->
+  | Pcl_structure { pcstr_self = pat; pcstr_fields = fieldl } ->
       let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pcl_fun(_, opte, pat, ce) ->
       add_opt add_expr bv opte;
@@ -311,16 +335,18 @@ and add_class_expr bv ce =
       let bv = add_bindings rf bv pel in add_class_expr bv ce
   | Pcl_constraint(ce, ct) ->
       add_class_expr bv ce; add_class_type bv ct
+  | Pcl_extension _ -> ()
 
 and add_class_field bv pcf =
   match pcf.pcf_desc with
-    Pcf_inher(_, ce, _) -> add_class_expr bv ce
-  | Pcf_val(_, _, _, e) -> add_expr bv e
-  | Pcf_valvirt(_, _, ty)
-  | Pcf_virt(_, _, ty) -> add_type bv ty
-  | Pcf_meth(_, _, _, e) -> add_expr bv e
-  | Pcf_constr(ty1, ty2) -> add_type bv ty1; add_type bv ty2
-  | Pcf_init e -> add_expr bv e
+    Pcf_inherit(_, ce, _) -> add_class_expr bv ce
+  | Pcf_val(_, _, Cfk_concrete (_, e))
+  | Pcf_method(_, _, Cfk_concrete (_, e)) -> add_expr bv e
+  | Pcf_val(_, _, Cfk_virtual ty)
+  | Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty
+  | Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pcf_initializer e -> add_expr bv e
+  | Pcf_extension _ -> ()
 
 and add_class_declaration bv decl =
   add_class_expr bv decl.pci_expr
diff --git a/tools/dump_ast.ml b/tools/dump_ast.ml
new file mode 100644
index 000000000..2907e5bf8
--- /dev/null
+++ b/tools/dump_ast.ml
@@ -0,0 +1,127 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+let autoopen_modules = ["Parsetree"; "Asttypes"; "Longident"; "Location"; "Lexing"]
+let autoopen = ref true
+
+let typ ty =
+  let ty = Parse.core_type (Lexing.from_string ty) in
+  let ty = Typetexp.transl_simple_type Env.initial false ty in
+  ty.Typedtree.ctyp_type
+
+let show_value ty v =
+  let env = Env.initial in
+  let env = if !autoopen then List.fold_right Env.open_pers_signature autoopen_modules env else env in
+  Format.printf "%a@." (Toploop.print_value env (Obj.repr v)) (typ ty)
+
+let dump_file fn =
+  let ic = open_in fn in
+  let buf = Lexing.from_channel ic in
+  if Filename.check_suffix fn ".mli"
+  then show_value "Parsetree.signature" (Parse.interface buf)
+  else show_value "Parsetree.structure" (Parse.implementation buf);
+  close_in ic
+
+let dump_expr s =
+  show_value "Parsetree.expression" (Parse.expression (Lexing.from_string s))
+
+let dump_type s =
+  show_value "Parsetree.core_type" (Parse.core_type (Lexing.from_string s))
+
+let dump_pattern s =
+  show_value "Parsetree.pattern" (Parse.pattern (Lexing.from_string s))
+
+(* Filtering of output *)
+
+module Filter = struct
+  open Outcometree
+
+  let hidelocs = ref true
+  let hideattrs = ref true
+
+  let map_oval f = function
+    | Oval_array l -> Oval_array (List.map f l)
+    | Oval_constr (i, l) -> Oval_constr (i, List.map f l)
+    | Oval_list l -> Oval_list (List.map f l)
+    | Oval_record l -> Oval_record (List.map (fun (s, x) -> (s, f x)) l)
+    | Oval_tuple l -> Oval_tuple (List.map f l)
+    | Oval_variant (s, Some x) -> Oval_variant (s, Some (f x))
+    | x -> x
+
+  let ends_with s l =
+    let ll = String.length l and ls = String.length s in
+    ll >= ls && String.sub l (ll - ls) ls = s
+
+  let filter_field = function
+    | (Oide_ident l, Oval_list [])
+      when !hideattrs && ends_with "_attributes" l -> false
+    | (Oide_ident l, _)
+      when !hidelocs && (ends_with "_loc" l || l = "loc") -> false
+    | _ -> true
+
+  let rec filter_val x =
+    match map_oval filter_val x with
+    | Oval_record l -> Oval_record (List.filter filter_field l)
+    | x -> x
+
+  let () =
+    let old = !Oprint.out_value in
+    Oprint.out_value := (fun ppf v -> old ppf (filter_val v))
+end
+
+(* Command-line parsing *)
+
+let args =
+  let open Arg in
+  [
+   "-noopen", Clear autoopen,
+   " Don't assume that default modules are opened";
+
+   "-locs", Clear Filter.hidelocs,
+   " Keep locations";
+
+   "-emptyattrs", Clear Filter.hideattrs,
+   " Keep empty attributes";
+
+   "-e", String dump_expr,
+   "<expr> Dump the AST for <expr>";
+
+   "-t", String dump_type,
+   "<type> Dump the AST for <type>";
+
+   "-p", String dump_pattern,
+   "<pattern> Dump the AST for <pattern>";
+
+   "-w", Int Format.set_margin,
+   "<width> Define the width (in characters) of the output"
+  ]
+
+let usage = "dump_ast [options] <.ml/.mli source files>\n"
+
+let () =
+  let dir = Filename.dirname Sys.argv.(0) in
+  let c0 = Filename.concat dir in
+  let c1 = Filename.concat Config.standard_library in
+
+  if Sys.file_exists (c1 "compiler-libs/parsetree.cmi")
+  then Config.load_path := [c1 "compiler-libs"; Config.standard_library]
+  else if Sys.file_exists (c0 "../parsing/parsetree.cmi")
+  (* Running from a source tree. *)
+  then Config.load_path := [c0 "../parsing"; c0 "../stdlib"]
+  else (prerr_endline "Cannot locate parsetree.cmi"; exit 2);
+
+  Toploop.initialize_toplevel_env ();
+  Toploop.max_printer_depth := max_int;
+  Toploop.max_printer_steps := max_int;
+
+  try Arg.parse (Arg.align args) dump_file usage
+  with exn -> Errors.report_error Format.err_formatter exn
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index df654a94c..d517dc016 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -82,7 +82,7 @@ let print_float f =
 let rec print_struct_const = function
     Const_base(Const_int i) -> printf "%d" i
   | Const_base(Const_float f) -> print_float f
-  | Const_base(Const_string s) -> printf "%S" s
+  | Const_base(Const_string (s, _)) -> printf "%S" s
   | Const_immstring s -> printf "%S" s
   | Const_base(Const_char c) -> printf "%C" c
   | Const_base(Const_int32 i) -> printf "%ldl" i
diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml
index 454a3ddd2..6331cb4d0 100644
--- a/tools/eqparsetree.ml
+++ b/tools/eqparsetree.ml
@@ -231,10 +231,9 @@ let rec eq_pattern_desc : (pattern_desc * pattern_desc) -> 'result =
   | (Ppat_constant a0, Ppat_constant b0) ->
       Asttypes.eq_constant (a0, b0)
   | (Ppat_tuple a0, Ppat_tuple b0) -> eq_list eq_pattern (a0, b0)
-  | (Ppat_construct (a0, a1, a2), Ppat_construct (b0, b1, b2)) ->
+  | (Ppat_construct (a0, a1), Ppat_construct (b0, b1)) ->
       ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
          (eq_option eq_pattern (a1, b1)))
-        && (eq_bool (a2, b2))
   | (Ppat_variant (a0, a1), Ppat_variant (b0, b1)) ->
       (Asttypes.eq_label (a0, b0)) && (eq_option eq_pattern (a1, b1))
   | (Ppat_record (a0, a1), Ppat_record (b0, b1)) ->
@@ -471,8 +470,8 @@ and eq_class_field : (class_field * class_field) -> 'result =
 and eq_class_structure :
   (class_structure * class_structure) -> 'result =
   fun
-    ({ pcstr_pat = a0; pcstr_fields = a1 },
-     { pcstr_pat = b0; pcstr_fields = b1 })
+    ({ pcstr_self = a0; pcstr_fields = a1 },
+     { pcstr_self = b0; pcstr_fields = b1 })
     -> (eq_pattern (a0, b0)) && (eq_list eq_class_field (a1, b1))
 and eq_class_expr_desc :
   (class_expr_desc * class_expr_desc) -> 'result =
@@ -565,7 +564,7 @@ and eq_class_type_desc :
         (eq_list eq_core_type (a1, b1))
   | (Pcty_signature a0, Pcty_signature b0) ->
       eq_class_signature (a0, b0)
-  | (Pcty_fun (a0, a1, a2), Pcty_fun (b0, b1, b2)) ->
+  | (Pcty_arrow (a0, a1, a2), Pcty_arrow (b0, b1, b2)) ->
       ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
         (eq_class_type (a2, b2))
   | (_, _) -> false
@@ -657,14 +656,17 @@ and eq_expression_desc :
                (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
             (a1, b1)))
         && (eq_expression (a2, b2))
-  | (Pexp_function (a0, a1, a2), Pexp_function (b0, b1, b2)) ->
+  | Pexp_fun (a1, a1, a2, a3), Pexp_function (b0, b1, b2, b3) ->
       ((Asttypes.eq_label (a0, b0)) &&
-         (eq_option eq_expression (a1, b1)))
-        &&
-        (eq_list
-           (fun ((a0, a1), (b0, b1)) ->
-              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
-           (a2, b2))
+       (eq_option eq_expression (a1, b1)) &&
+       (eq_pattern a2 b2) &&
+       (eq_expression (a3, b3)))
+  | (Pexp_function (a0, a1, a2), Pexp_function (b0, b1, b2)) ->
+      (* FIX *)
+      eq_list
+        (fun ((a0, a1), (b0, b1)) ->
+          (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
+        (a2, b2))
   | (Pexp_apply (a0, a1), Pexp_apply (b0, b1)) ->
       (eq_expression (a0, b0)) &&
         (eq_list
@@ -685,10 +687,9 @@ and eq_expression_desc :
               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
            (a1, b1))
   | (Pexp_tuple a0, Pexp_tuple b0) -> eq_list eq_expression (a0, b0)
-  | (Pexp_construct (a0, a1, a2), Pexp_construct (b0, b1, b2)) ->
+  | (Pexp_construct (a0, a1), Pexp_construct (b0, b1)) ->
       ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
          (eq_option eq_expression (a1, b1)))
-        && (eq_bool (a2, b2))
   | (Pexp_variant (a0, a1), Pexp_variant (b0, b1)) ->
       (Asttypes.eq_label (a0, b0)) &&
         (eq_option eq_expression (a1, b1))
@@ -743,7 +744,6 @@ and eq_expression_desc :
          (eq_module_expr (a1, b1)))
         && (eq_expression (a2, b2))
   | (Pexp_assert a0, Pexp_assert b0) -> eq_expression (a0, b0)
-  | (Pexp_assertfalse, Pexp_assertfalse) -> true
   | (Pexp_lazy a0, Pexp_lazy b0) -> eq_expression (a0, b0)
   | (Pexp_poly (a0, a1), Pexp_poly (b0, b1)) ->
       (eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1))
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index 72c990099..77c50168a 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -148,10 +148,18 @@ let final_rewrite add_function =
 ;;
 
 let rec rewrite_patexp_list iflag l =
-  rewrite_exp_list iflag (List.map snd l)
+  rewrite_exp_list iflag (List.map (fun x -> x.pvb_expr) l)
 
-and rewrite_patlexp_list iflag l =
-  rewrite_exp_list iflag (List.map snd l)
+and rewrite_cases iflag l =
+  List.iter
+    (fun pc ->
+      begin match pc.pc_guard with
+      | None -> ()
+      | Some g -> rewrite_exp iflag g
+      end;
+      rewrite_exp iflag pc.pc_rhs
+    )
+    l
 
 and rewrite_labelexp_list iflag l =
   rewrite_exp_list iflag (List.map snd l)
@@ -172,25 +180,32 @@ and rw_exp iflag sexp =
     rewrite_patexp_list iflag spat_sexp_list;
     rewrite_exp iflag sbody
 
-  | Pexp_function (_, _, caselist) ->
+  | Pexp_function caselist ->
     if !instr_fun then
       rewrite_function iflag caselist
     else
-      rewrite_patlexp_list iflag caselist
+      rewrite_cases iflag caselist
+
+  | Pexp_fun (_, _, p, e) ->
+      let l = [{pc_lhs=p; pc_guard=None; pc_rhs=e}] in
+      if !instr_fun then
+        rewrite_function iflag l
+      else
+        rewrite_cases iflag l
 
   | Pexp_match(sarg, caselist) ->
     rewrite_exp iflag sarg;
     if !instr_match && not sexp.pexp_loc.loc_ghost then
       rewrite_funmatching caselist
     else
-      rewrite_patlexp_list iflag caselist
+      rewrite_cases iflag caselist
 
   | Pexp_try(sbody, caselist) ->
     rewrite_exp iflag sbody;
     if !instr_try && not sexp.pexp_loc.loc_ghost then
       rewrite_trymatching caselist
     else
-      rewrite_patexp_list iflag caselist
+      rewrite_cases iflag caselist
 
   | Pexp_apply(sfunct, sargs) ->
     rewrite_exp iflag sfunct;
@@ -199,8 +214,8 @@ and rw_exp iflag sexp =
   | Pexp_tuple sexpl ->
     rewrite_exp_list iflag sexpl
 
-  | Pexp_construct(_, None, _) -> ()
-  | Pexp_construct(_, Some sarg, _) ->
+  | Pexp_construct(_, None) -> ()
+  | Pexp_construct(_, Some sarg) ->
     rewrite_exp iflag sarg
 
   | Pexp_variant(_, None) -> ()
@@ -248,13 +263,9 @@ and rw_exp iflag sexp =
     then insert_profile rw_exp sbody
     else rewrite_exp iflag sbody
 
-  | Pexp_constraint(sarg, _, _) ->
+  | Pexp_constraint(sarg, _) | Pexp_coerce(sarg, _, _) ->
     rewrite_exp iflag sarg
 
-  | Pexp_when(scond, sbody) ->
-    rewrite_exp iflag scond;
-    rewrite_exp iflag sbody
-
   | Pexp_send (sobj, _) ->
     rewrite_exp iflag sobj
 
@@ -271,7 +282,6 @@ and rw_exp iflag sexp =
       rewrite_exp iflag sexp
 
   | Pexp_assert (cond) -> rewrite_exp iflag cond
-  | Pexp_assertfalse -> ()
 
   | Pexp_lazy (expr) -> rewrite_exp iflag expr
 
@@ -283,6 +293,7 @@ and rw_exp iflag sexp =
   | Pexp_newtype (_, sexp) -> rewrite_exp iflag sexp
   | Pexp_open (_ovf, _, e) -> rewrite_exp iflag e
   | Pexp_pack (smod) -> rewrite_mod iflag smod
+  | Pexp_extension _ -> ()
 
 and rewrite_ifbody iflag ghost sifbody =
   if !instr_if && not ghost then
@@ -294,39 +305,46 @@ and rewrite_ifbody iflag ghost sifbody =
 and rewrite_annotate_exp_list l =
   List.iter
     (function
-     | {pexp_desc = Pexp_when(scond, sbody)}
-        -> insert_profile rw_exp scond;
-           insert_profile rw_exp sbody;
-     | {pexp_desc = Pexp_constraint(sbody, _, _)} (* let f x : t = e *)
+     | {pc_guard=Some scond; pc_rhs=sbody} ->
+         insert_profile rw_exp scond;
+         insert_profile rw_exp sbody;
+     | {pc_rhs={pexp_desc = Pexp_constraint(sbody, _)}} (* let f x : t = e *)
         -> insert_profile rw_exp sbody
-     | sexp -> insert_profile rw_exp sexp)
+     | {pc_rhs=sexp} -> insert_profile rw_exp sexp)
     l
 
 and rewrite_function iflag = function
-  | [spat, ({pexp_desc = Pexp_function _} as sexp)] -> rewrite_exp iflag sexp
+  | [{pc_lhs=spat; pc_guard=None;
+      pc_rhs={pexp_desc = (Pexp_function _|Pexp_fun _)} as sexp}] ->
+        rewrite_exp iflag sexp
   | l -> rewrite_funmatching l
 
 and rewrite_funmatching l =
-  rewrite_annotate_exp_list (List.map snd l)
+  rewrite_annotate_exp_list l
 
 and rewrite_trymatching l =
-  rewrite_annotate_exp_list (List.map snd l)
+  rewrite_annotate_exp_list l
 
 (* Rewrite a class definition *)
 
 and rewrite_class_field iflag cf =
   match cf.pcf_desc with
-    Pcf_inher (_, cexpr, _)     -> rewrite_class_expr iflag cexpr
-  | Pcf_val (_, _, _, sexp)  -> rewrite_exp iflag sexp
-  | Pcf_meth (_, _, _, ({pexp_desc = Pexp_function _} as sexp)) ->
+    Pcf_inherit (_, cexpr, _)     -> rewrite_class_expr iflag cexpr
+  | Pcf_val (_, _, Cfk_concrete (_, sexp))  -> rewrite_exp iflag sexp
+  | Pcf_method (_, _,
+                Cfk_concrete (_, ({pexp_desc = (Pexp_function _|Pexp_fun _)}
+                                    as sexp))) ->
       rewrite_exp iflag sexp
-  | Pcf_meth (_, _, _, sexp) ->
+  | Pcf_method (_, _, Cfk_concrete(_, sexp)) ->
       let loc = cf.pcf_loc in
       if !instr_fun && not loc.loc_ghost then insert_profile rw_exp sexp
       else rewrite_exp iflag sexp
-  | Pcf_init sexp ->
+  | Pcf_initializer sexp ->
       rewrite_exp iflag sexp
-  | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _  -> ()
+  | Pcf_method (_, _, Cfk_virtual _)
+  | Pcf_val (_, _, Cfk_virtual _)
+  | Pcf_constraint _  -> ()
+  | Pcf_extension _ -> ()
 
 and rewrite_class_expr iflag cexpr =
   match cexpr.pcl_desc with
@@ -343,6 +361,7 @@ and rewrite_class_expr iflag cexpr =
       rewrite_class_expr iflag cexpr
   | Pcl_constraint (cexpr, _) ->
       rewrite_class_expr iflag cexpr
+  | Pcl_extension _ -> ()
 
 and rewrite_class_declaration iflag cl =
   rewrite_class_expr iflag cl.pci_expr
@@ -357,13 +376,15 @@ and rewrite_mod iflag smod =
   | Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2
   | Pmod_constraint(smod, smty) -> rewrite_mod iflag smod
   | Pmod_unpack(sexp) -> rewrite_exp iflag sexp
+  | Pmod_extension _ -> ()
 
 and rewrite_str_item iflag item =
   match item.pstr_desc with
-    Pstr_eval exp -> rewrite_exp iflag exp
+    Pstr_eval (exp, _attrs) -> rewrite_exp iflag exp
   | Pstr_value(_, exps)
-     -> List.iter (function (_,exp) -> rewrite_exp iflag exp) exps
-  | Pstr_module(name, smod) -> rewrite_mod iflag smod
+     -> List.iter (fun x -> rewrite_exp iflag x.pvb_expr) exps
+  | Pstr_module x -> rewrite_mod iflag x.pmb_expr
+        (* todo: Pstr_recmodule?? *)
   | Pstr_class classes -> List.iter (rewrite_class_declaration iflag) classes
   | _ -> ()
 
diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml
index b02a4d2df..776e33522 100644
--- a/tools/tast_iter.ml
+++ b/tools/tast_iter.ml
@@ -10,7 +10,6 @@
 (*                                                                     *)
 (***********************************************************************)
 
-open Asttypes
 open Typedtree
 
 let opt f = function None -> () | Some x -> f x
@@ -18,30 +17,28 @@ let opt f = function None -> () | Some x -> f x
 let structure sub str =
   List.iter (sub # structure_item) str.str_items
 
+let constructor_decl sub cd =
+  List.iter (sub # core_type) cd.cd_args;
+  opt (sub # core_type) cd.cd_res
+
 let structure_item sub x =
   match x.str_desc with
-  | Tstr_eval exp -> sub # expression exp
+  | Tstr_eval (exp, _attrs) -> sub # expression exp
   | Tstr_value (rec_flag, list) -> sub # bindings (rec_flag, list)
-  | Tstr_primitive (_id, _, v) -> sub # value_description v
-  | Tstr_type list ->
-      List.iter (fun (_id, _, decl) -> sub # type_declaration decl) list
-  | Tstr_exception (_id, _, decl) -> sub # exception_declaration decl
-  | Tstr_exn_rebind (_id, _, _p, _) -> ()
-  | Tstr_module (_id, _, mexpr) -> sub # module_expr mexpr
-  | Tstr_recmodule list ->
-      List.iter
-        (fun (_id, _, mtype, mexpr) ->
-          sub # module_type mtype;
-          sub # module_expr mexpr
-        )
-        list
-  | Tstr_modtype (_id, _, mtype) -> sub # module_type mtype
+  | Tstr_primitive v -> sub # value_description v
+  | Tstr_type list -> List.iter (sub # type_declaration) list
+  | Tstr_exception decl -> constructor_decl sub decl
+  | Tstr_exn_rebind (_id, _, _p, _, _) -> ()
+  | Tstr_module mb -> sub # module_binding mb
+  | Tstr_recmodule list -> List.iter (sub # module_binding) list
+  | Tstr_modtype mtd -> opt (sub # module_type) mtd.mtd_type
   | Tstr_open _ -> ()
   | Tstr_class list ->
       List.iter (fun (ci, _, _) -> sub # class_expr ci.ci_expr) list
   | Tstr_class_type list ->
       List.iter (fun (_id, _, ct) -> sub # class_type ct.ci_expr) list
-  | Tstr_include (mexpr, _) -> sub # module_expr mexpr
+  | Tstr_include (mexpr, _, _) -> sub # module_expr mexpr
+  | Tstr_attribute _ -> ()
 
 let value_description sub x =
   sub # core_type x.val_desc
@@ -53,28 +50,25 @@ let type_declaration sub decl =
   begin match decl.typ_kind with
   | Ttype_abstract -> ()
   | Ttype_variant list ->
-      List.iter (fun (_s, _, cts, _loc) -> List.iter (sub # core_type) cts) list
+      List.iter (constructor_decl sub) list
   | Ttype_record list ->
-      List.iter (fun (_s, _, _mut, ct, _loc) -> sub # core_type ct) list
+      List.iter (fun ld -> sub # core_type ld.ld_type) list
   end;
   opt (sub # core_type) decl.typ_manifest
 
-let exception_declaration sub decl =
-  List.iter (sub # core_type) decl.exn_params
-
 let pattern sub pat =
   let extra = function
     | Tpat_type _
     | Tpat_unpack -> ()
     | Tpat_constraint ct -> sub # core_type ct
   in
-  List.iter (fun (c, _) -> extra c) pat.pat_extra;
+  List.iter (fun (c, _, _) -> extra c) pat.pat_extra;
   match pat.pat_desc with
   | Tpat_any
   | Tpat_var _
   | Tpat_constant _ -> ()
   | Tpat_tuple l
-  | Tpat_construct (_, _, l, _) -> List.iter (sub # pattern) l
+  | Tpat_construct (_, _, l) -> List.iter (sub # pattern) l
   | Tpat_variant (_, po, _) -> opt (sub # pattern) po
   | Tpat_record (l, _) -> List.iter (fun (_, _, pat) -> sub # pattern pat) l
   | Tpat_array l -> List.iter (sub # pattern) l
@@ -84,13 +78,15 @@ let pattern sub pat =
 
 let expression sub exp =
   let extra = function
-    | Texp_constraint (cty1, cty2) ->
-        opt (sub # core_type) cty1; opt (sub # core_type) cty2
+    | Texp_constraint cty ->
+        sub # core_type cty
+    | Texp_coerce (cty1, cty2) ->
+        opt (sub # core_type) cty1; sub # core_type cty2
     | Texp_open _
     | Texp_newtype _ -> ()
     | Texp_poly cto -> opt (sub # core_type) cto
   in
-  List.iter (function (c, _) -> extra c) exp.exp_extra;
+  List.iter (fun (c, _, _) -> extra c) exp.exp_extra;
   match exp.exp_desc with
   | Texp_ident _
   | Texp_constant _ -> ()
@@ -98,19 +94,19 @@ let expression sub exp =
       sub # bindings (rec_flag, list);
       sub # expression exp
   | Texp_function (_, cases, _) ->
-      sub # bindings (Nonrecursive, cases)
+      sub # cases cases
   | Texp_apply (exp, list) ->
       sub # expression exp;
       List.iter (fun (_, expo, _) -> opt (sub # expression) expo) list
-  | Texp_match (exp, list, _) ->
+  | Texp_match (exp, cases, _) ->
       sub # expression exp;
-      sub # bindings (Nonrecursive, list)
-  | Texp_try (exp, list) ->
+      sub # cases cases
+  | Texp_try (exp, cases) ->
       sub # expression exp;
-      sub # bindings (Nonrecursive, list)
+      sub # cases cases
   | Texp_tuple list ->
       List.iter (sub # expression) list
-  | Texp_construct (_, _, args, _) ->
+  | Texp_construct (_, _, args) ->
       List.iter (sub # expression) args
   | Texp_variant (_, expo) ->
       opt (sub # expression) expo
@@ -138,9 +134,6 @@ let expression sub exp =
       sub # expression exp1;
       sub # expression exp2;
       sub # expression exp3
-  | Texp_when (exp1, exp2) ->
-      sub # expression exp1;
-      sub # expression exp2
   | Texp_send (exp, _meth, expo) ->
       sub # expression exp;
       opt (sub # expression) expo
@@ -154,7 +147,6 @@ let expression sub exp =
       sub # module_expr mexpr;
       sub # expression exp
   | Texp_assert exp -> sub # expression exp
-  | Texp_assertfalse -> ()
   | Texp_lazy exp -> sub # expression exp
   | Texp_object (cl, _) ->
       sub # class_structure cl
@@ -170,29 +162,25 @@ let signature sub sg =
 
 let signature_item sub item =
   match item.sig_desc with
-  | Tsig_value (_id, _, v) ->
+  | Tsig_value v ->
       sub # value_description v
   | Tsig_type list ->
-      List.iter (fun (_id, _, decl) -> sub # type_declaration decl) list
-  | Tsig_exception (_id, _, decl) ->
-      sub # exception_declaration decl
-  | Tsig_module (_id, _, mtype) ->
-      sub # module_type mtype
+      List.iter (sub # type_declaration) list
+  | Tsig_exception decl ->
+      constructor_decl sub decl
+  | Tsig_module md ->
+      sub # module_type md.md_type
   | Tsig_recmodule list ->
-      List.iter (fun (_id, _, mtype) -> sub # module_type mtype) list
-  | Tsig_modtype (_id, _, mdecl) ->
-      sub # modtype_declaration mdecl
+      List.iter (fun md -> sub # module_type md.md_type) list
+  | Tsig_modtype mtd ->
+      opt (sub # module_type) mtd.mtd_type
   | Tsig_open _ -> ()
-  | Tsig_include (mty,_) -> sub # module_type mty
+  | Tsig_include (mty,_,_) -> sub # module_type mty
   | Tsig_class list ->
       List.iter (sub # class_description) list
   | Tsig_class_type list ->
       List.iter (sub # class_type_declaration) list
-
-let modtype_declaration sub mdecl =
-  match mdecl with
-  | Tmodtype_abstract -> ()
-  | Tmodtype_manifest mtype -> sub # module_type mtype
+  | Tsig_attribute _ -> ()
 
 let class_description sub cd =
   sub # class_type cd.ci_expr
@@ -238,6 +226,9 @@ let module_expr sub mexpr =
       sub # expression exp
 (*          sub # module_type mty *)
 
+let module_binding sub mb =
+  module_expr sub mb.mb_expr
+
 let class_expr sub cexpr =
   match cexpr.cl_desc with
   | Tcl_constraint (cl, None, _, _, _ ) ->
@@ -264,7 +255,7 @@ let class_type sub ct =
   match ct.cltyp_desc with
   | Tcty_signature csg -> sub # class_signature csg
   | Tcty_constr (_path, _, list) -> List.iter (sub # core_type) list
-  | Tcty_fun (_label, ct, cl) ->
+  | Tcty_arrow (_label, ct, cl) ->
       sub # core_type ct;
       sub # class_type cl
 
@@ -274,14 +265,12 @@ let class_signature sub cs =
 
 let class_type_field sub ctf =
   match ctf.ctf_desc with
-  | Tctf_inher ct -> sub # class_type ct
+  | Tctf_inherit ct -> sub # class_type ct
   | Tctf_val (_s, _mut, _virt, ct) ->
       sub # core_type ct
-  | Tctf_virt  (_s, _priv, ct) ->
-      sub # core_type ct
-  | Tctf_meth  (_s, _priv, ct) ->
+  | Tctf_method (_s, _priv, _virt, ct) ->
       sub # core_type ct
-  | Tctf_cstr  (ct1, ct2) ->
+  | Tctf_constraint  (ct1, ct2) ->
       sub # core_type ct1;
       sub # core_type ct2
 
@@ -295,9 +284,9 @@ let core_type sub ct =
   | Ttyp_tuple list -> List.iter (sub # core_type) list
   | Ttyp_constr (_path, _, list) ->
       List.iter (sub # core_type) list
-  | Ttyp_object list ->
-      List.iter (sub # core_field_type) list
-  | Ttyp_class (_path, _, list, _labels) ->
+  | Ttyp_object (list, _o) ->
+      List.iter (fun (_, t) -> sub # core_type t) list
+  | Ttyp_class (_path, _, list) ->
       List.iter (sub # core_type) list
   | Ttyp_alias (ct, _s) ->
       sub # core_type ct
@@ -306,13 +295,8 @@ let core_type sub ct =
   | Ttyp_poly (_list, ct) -> sub # core_type ct
   | Ttyp_package pack -> sub # package_type pack
 
-let core_field_type sub cft =
-  match cft.field_desc with
-  | Tcfield_var -> ()
-  | Tcfield (_s, ct) -> sub # core_type ct
-
 let class_structure sub cs =
-  sub # pattern cs.cstr_pat;
+  sub # pattern cs.cstr_self;
   List.iter (sub # class_field) cs.cstr_fields
 
 let row_field sub rf =
@@ -322,32 +306,42 @@ let row_field sub rf =
 
 let class_field sub cf =
   match cf.cf_desc with
-  | Tcf_inher (_ovf, cl, _super, _vals, _meths) ->
+  | Tcf_inherit (_ovf, cl, _super, _vals, _meths) ->
       sub # class_expr cl
-  | Tcf_constr (cty, cty') ->
+  | Tcf_constraint (cty, cty') ->
       sub # core_type cty;
       sub # core_type cty'
-  | Tcf_val (_lab, _, _, _mut, Tcfk_virtual cty, _override) ->
+  | Tcf_val (_, _, _mut, Tcfk_virtual cty, _override) ->
       sub # core_type cty
-  | Tcf_val (_lab, _, _, _mut, Tcfk_concrete exp, _override) ->
+  | Tcf_val (_, _, _mut, Tcfk_concrete (_, exp), _override) ->
       sub # expression exp
-  | Tcf_meth (_lab, _, _priv, Tcfk_virtual cty, _override) ->
+  | Tcf_method (_, _priv, Tcfk_virtual cty) ->
       sub # core_type cty
-  | Tcf_meth (_lab, _, _priv, Tcfk_concrete exp, _override) ->
+  | Tcf_method (_, _priv, Tcfk_concrete (_, exp)) ->
       sub # expression exp
-  | Tcf_init exp ->
+  | Tcf_initializer exp ->
       sub # expression exp
 
 let bindings sub (_rec_flag, list) =
   List.iter (sub # binding) list
 
-let binding sub (pat, exp) =
-  sub # pattern pat;
-  sub # expression exp
+let cases sub l =
+  List.iter (sub # case) l
+
+let case sub {c_lhs; c_guard; c_rhs} =
+  sub # pattern c_lhs;
+  opt (sub # expression) c_guard;
+  sub # expression c_rhs
+
+let binding sub vb =
+  sub # pattern vb.vb_pat;
+  sub # expression vb.vb_expr
 
 class iter = object(this)
   method binding = binding this
   method bindings = bindings this
+  method case = case this
+  method cases = cases this
   method class_description = class_description this
   method class_expr = class_expr this
   method class_field = class_field this
@@ -356,11 +350,9 @@ class iter = object(this)
   method class_type = class_type this
   method class_type_declaration = class_type_declaration this
   method class_type_field = class_type_field this
-  method core_field_type = core_field_type this
   method core_type = core_type this
-  method exception_declaration = exception_declaration this
   method expression = expression this
-  method modtype_declaration = modtype_declaration this
+  method module_binding = module_binding this
   method module_expr = module_expr this
   method module_type = module_type this
   method package_type = package_type this
diff --git a/tools/tast_iter.mli b/tools/tast_iter.mli
index cc9bbcae4..f80609566 100644
--- a/tools/tast_iter.mli
+++ b/tools/tast_iter.mli
@@ -14,8 +14,10 @@ open Asttypes
 open Typedtree
 
 class iter: object
-  method binding: (pattern * expression) -> unit
-  method bindings: (rec_flag * (pattern * expression) list) -> unit
+  method binding: value_binding -> unit
+  method bindings: (rec_flag * value_binding list) -> unit
+  method case: case -> unit
+  method cases: case list -> unit
   method class_description: class_description -> unit
   method class_expr: class_expr -> unit
   method class_field: class_field -> unit
@@ -24,11 +26,9 @@ class iter: object
   method class_type: class_type -> unit
   method class_type_declaration: class_type_declaration -> unit
   method class_type_field: class_type_field -> unit
-  method core_field_type: core_field_type -> unit
   method core_type: core_type -> unit
-  method exception_declaration: exception_declaration -> unit
   method expression: expression -> unit
-  method modtype_declaration: modtype_declaration -> unit
+  method module_binding: module_binding -> unit
   method module_expr: module_expr -> unit
   method module_type: module_type -> unit
   method package_type: package_type -> unit
@@ -51,8 +51,8 @@ end
 (** The following functions apply the provided iterator to each
     sub-component of the argument. *)
 
-val binding: iter -> (pattern * expression) -> unit
-val bindings: iter -> (rec_flag * (pattern * expression) list) -> unit
+val binding: iter -> value_binding -> unit
+val bindings: iter -> (rec_flag * value_binding list) -> unit
 val class_description: iter -> class_description -> unit
 val class_expr: iter -> class_expr -> unit
 val class_field: iter -> class_field -> unit
@@ -61,11 +61,9 @@ val class_structure: iter -> class_structure -> unit
 val class_type: iter -> class_type -> unit
 val class_type_declaration: iter -> class_type_declaration -> unit
 val class_type_field: iter -> class_type_field -> unit
-val core_field_type: iter -> core_field_type -> unit
 val core_type: iter -> core_type -> unit
-val exception_declaration: iter -> exception_declaration -> unit
 val expression: iter -> expression -> unit
-val modtype_declaration: iter -> modtype_declaration -> unit
+val module_binding: iter -> module_binding -> unit
 val module_expr: iter -> module_expr -> unit
 val module_type: iter -> module_type -> unit
 val package_type: iter -> package_type -> unit
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index c1b426443..0e727d027 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -13,6 +13,7 @@
 open Asttypes
 open Typedtree
 open Parsetree
+open Ast_helper
 
 (*
 Some notes:
@@ -30,6 +31,8 @@ Some notes:
 *)
 
 
+let option f = function None -> None | Some e -> Some (f e)
+
 let rec lident_of_path path =
   match path with
       Path.Pident id -> Longident.Lident (Ident.name id)
@@ -43,36 +46,32 @@ let rec untype_structure str =
 and untype_structure_item item =
   let desc =
     match item.str_desc with
-      Tstr_eval exp -> Pstr_eval (untype_expression exp)
+      Tstr_eval (exp, attrs) -> Pstr_eval (untype_expression exp, attrs)
     | Tstr_value (rec_flag, list) ->
-        Pstr_value (rec_flag, List.map (fun (pat, exp) ->
-              untype_pattern pat, untype_expression exp) list)
-    | Tstr_primitive (_id, name, v) ->
-        Pstr_primitive (name, untype_value_description v)
+        Pstr_value (rec_flag, List.map untype_binding list)
+    | Tstr_primitive vd ->
+        Pstr_primitive (untype_value_description vd)
     | Tstr_type list ->
-        Pstr_type (List.map (fun (_id, name, decl) ->
-              name, untype_type_declaration decl) list)
-    | Tstr_exception (_id, name, decl) ->
-        Pstr_exception (name, untype_exception_declaration decl)
-    | Tstr_exn_rebind (_id, name, _p, lid) ->
-        Pstr_exn_rebind (name, lid)
-    | Tstr_module (_id, name, mexpr) ->
-        Pstr_module (name, untype_module_expr mexpr)
+        Pstr_type (List.map untype_type_declaration list)
+    | Tstr_exception decl ->
+        Pstr_exception (untype_constructor_declaration decl)
+    | Tstr_exn_rebind (_id, name, _p, lid, attrs) ->
+        Pstr_exn_rebind (name, lid, attrs)
+    | Tstr_module mb ->
+        Pstr_module (untype_module_binding mb)
     | Tstr_recmodule list ->
-        Pstr_recmodule (List.map (fun (_id, name, mtype, mexpr) ->
-              name, untype_module_type mtype,
-              untype_module_expr mexpr) list)
-    | Tstr_modtype (_id, name, mtype) ->
-        Pstr_modtype (name, untype_module_type mtype)
-    | Tstr_open (ovf, _path, lid) -> Pstr_open (ovf, lid)
+        Pstr_recmodule (List.map untype_module_binding list)
+    | Tstr_modtype mtd ->
+        Pstr_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; pmtd_attributes=mtd.mtd_attributes}
+    | Tstr_open (ovf, _path, lid, attrs) -> Pstr_open (ovf, lid, attrs)
     | Tstr_class list ->
         Pstr_class (List.map (fun (ci, _, _) ->
               { pci_virt = ci.ci_virt;
                 pci_params = ci.ci_params;
                 pci_name = ci.ci_id_name;
                 pci_expr = untype_class_expr ci.ci_expr;
-                pci_variance = ci.ci_variance;
                 pci_loc = ci.ci_loc;
+                pci_attributes = ci.ci_attributes;
               }
           ) list)
     | Tstr_class_type list ->
@@ -82,23 +81,36 @@ and untype_structure_item item =
                 pci_params = ct.ci_params;
                 pci_name = ct.ci_id_name;
                 pci_expr = untype_class_type ct.ci_expr;
-                pci_variance = ct.ci_variance;
                 pci_loc = ct.ci_loc;
+                pci_attributes = ct.ci_attributes;
               }
           ) list)
-    | Tstr_include (mexpr, _) ->
-        Pstr_include (untype_module_expr mexpr)
+    | Tstr_include (mexpr, _, attrs) ->
+        Pstr_include (untype_module_expr mexpr, attrs)
+    | Tstr_attribute x ->
+        Pstr_attribute x
   in
   { pstr_desc = desc; pstr_loc = item.str_loc; }
 
 and untype_value_description v =
   {
-    pval_prim = v.val_prim;
-    pval_type = untype_core_type v.val_desc;
-    pval_loc = v.val_loc }
+   pval_name = v.val_name;
+   pval_prim = v.val_prim;
+   pval_type = untype_core_type v.val_desc;
+   pval_loc = v.val_loc;
+   pval_attributes = v.val_attributes;
+  }
+
+and untype_module_binding mb =
+  {
+   pmb_name = mb.mb_name;
+   pmb_expr = untype_module_expr mb.mb_expr;
+   pmb_attributes = mb.mb_attributes;
+  }
 
 and untype_type_declaration decl =
   {
+    ptype_name = decl.typ_name;
     ptype_params = decl.typ_params;
     ptype_cstrs = List.map (fun (ct1, ct2, loc) ->
         (untype_core_type ct1,
@@ -107,31 +119,37 @@ and untype_type_declaration decl =
     ptype_kind = (match decl.typ_kind with
         Ttype_abstract -> Ptype_abstract
       | Ttype_variant list ->
-          Ptype_variant (List.map (fun (_s, name, cts, loc) ->
-                (name, List.map untype_core_type cts, None, loc)
-            ) list)
+          Ptype_variant (List.map untype_constructor_declaration list)
       | Ttype_record list ->
-          Ptype_record (List.map (fun (_s, name, mut, ct, loc) ->
-                (name, mut, untype_core_type ct, loc)
+          Ptype_record (List.map (fun ld ->
+                {pld_name=ld.ld_name;
+                 pld_mutable=ld.ld_mutable;
+                 pld_type=untype_core_type ld.ld_type;
+                 pld_loc=ld.ld_loc;
+                 pld_attributes=ld.ld_attributes}
             ) list)
     );
     ptype_private = decl.typ_private;
-    ptype_manifest = (match decl.typ_manifest with
-        None -> None
-      | Some ct -> Some (untype_core_type ct));
-    ptype_variance = decl.typ_variance;
+    ptype_manifest = option untype_core_type decl.typ_manifest;
+    ptype_attributes = decl.typ_attributes;
     ptype_loc = decl.typ_loc;
   }
 
-and untype_exception_declaration decl =
-  List.map untype_core_type decl.exn_params
+and untype_constructor_declaration cd = 
+  {
+   pcd_name = cd.cd_name;
+   pcd_args = List.map untype_core_type cd.cd_args;
+   pcd_res = option untype_core_type cd.cd_res;
+   pcd_loc = cd.cd_loc;
+   pcd_attributes = cd.cd_attributes;
+  }
 
 and untype_pattern pat =
   let desc =
   match pat with
-      { pat_extra=[Tpat_unpack, _]; pat_desc = Tpat_var (_,name); _ } -> Ppat_unpack name
-    | { pat_extra=[Tpat_type (_path, lid), _]; _ } -> Ppat_type lid
-    | { pat_extra= (Tpat_constraint ct, _) :: rem; _ } ->
+      { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> Ppat_unpack name
+    | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } -> Ppat_type lid
+    | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } ->
         Ppat_constraint (untype_pattern { pat with pat_extra=rem }, untype_core_type ct)
     | _ ->
     match pat.pat_desc with
@@ -149,19 +167,19 @@ and untype_pattern pat =
     | Tpat_constant cst -> Ppat_constant cst
     | Tpat_tuple list ->
         Ppat_tuple (List.map untype_pattern list)
-    | Tpat_construct (lid, _, args, explicit_arity) ->
+    | Tpat_construct (lid, _, args) ->
         Ppat_construct (lid,
           (match args with
               [] -> None
             | [arg] -> Some (untype_pattern arg)
-            | args -> Some
-                  { ppat_desc = Ppat_tuple (List.map untype_pattern args);
-                  ppat_loc = pat.pat_loc; }
-          ), explicit_arity)
+            | args ->
+                Some
+                  (Pat.tuple ~loc:pat.pat_loc
+                     (List.map untype_pattern args)
+                  )
+          ))
     | Tpat_variant (label, pato, _) ->
-        Ppat_variant (label, match pato with
-            None -> None
-          | Some pat -> Some (untype_pattern pat))
+        Ppat_variant (label, option untype_pattern pato)
     | Tpat_record (list, closed) ->
         Ppat_record (List.map (fun (lid, _, pat) ->
               lid, untype_pattern pat) list, closed)
@@ -169,26 +187,38 @@ and untype_pattern pat =
     | Tpat_or (p1, p2, _) -> Ppat_or (untype_pattern p1, untype_pattern p2)
     | Tpat_lazy p -> Ppat_lazy (untype_pattern p)
   in
-  {
-    ppat_desc = desc;
-    ppat_loc = pat.pat_loc;
-  }
-
-and option f x = match x with None -> None | Some e -> Some (f e)
+  Pat.mk ~loc:pat.pat_loc ~attrs:pat.pat_attributes desc (* todo: fix attributes on extras *)
 
-and untype_extra (extra, loc) sexp =
+and untype_extra (extra, loc, attrs) sexp =
   let desc =
     match extra with
-      Texp_constraint (cty1, cty2) ->
-        Pexp_constraint (sexp,
-                         option untype_core_type cty1,
-                         option untype_core_type cty2)
+      Texp_coerce (cty1, cty2) ->
+        Pexp_coerce (sexp,
+                     option untype_core_type cty1,
+                     untype_core_type cty2)
+    | Texp_constraint cty ->
+        Pexp_constraint (sexp, untype_core_type cty)
     | Texp_open (ovf, _path, lid, _) -> Pexp_open (ovf, lid, sexp)
     | Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto)
     | Texp_newtype s -> Pexp_newtype (s, sexp)
   in
-  { pexp_desc = desc;
-    pexp_loc = loc }
+  Exp.mk ~loc ~attrs desc
+
+and untype_cases l = List.map untype_case l
+
+and untype_case {c_lhs; c_guard; c_rhs} =
+  {
+   pc_lhs = untype_pattern c_lhs;
+   pc_guard = option untype_expression c_guard;
+   pc_rhs = untype_expression c_rhs;
+  }
+
+and untype_binding {vb_pat; vb_expr; vb_attributes} =
+  {
+    pvb_pat = untype_pattern vb_pat;
+    pvb_expr = untype_expression vb_expr;
+    pvb_attributes = vb_attributes;
+  }
 
 and untype_expression exp =
   let desc =
@@ -197,13 +227,14 @@ and untype_expression exp =
     | Texp_constant cst -> Pexp_constant cst
     | Texp_let (rec_flag, list, exp) ->
         Pexp_let (rec_flag,
-          List.map (fun (pat, exp) ->
-              untype_pattern pat, untype_expression exp) list,
+          List.map untype_binding list,
           untype_expression exp)
-    | Texp_function (label, cases, _) ->
-        Pexp_function (label, None,
-          List.map (fun (pat, exp) ->
-              (untype_pattern pat, untype_expression exp)) cases)
+    | Texp_function (label, [{c_lhs=p; c_guard=None; c_rhs=e}], _) ->
+        Pexp_fun (label, None, untype_pattern p, untype_expression e)
+    | Texp_function ("", cases, _) ->
+        Pexp_function (untype_cases cases)
+    | Texp_function _ ->
+        assert false
     | Texp_apply (exp, list) ->
         Pexp_apply (untype_expression exp,
           List.fold_right (fun (label, expo, _) list ->
@@ -211,36 +242,28 @@ and untype_expression exp =
                 None -> list
               | Some exp -> (label, untype_expression exp) :: list
           ) list [])
-    | Texp_match (exp, list, _) ->
-        Pexp_match (untype_expression exp,
-          List.map (fun (pat, exp) ->
-              untype_pattern pat, untype_expression exp) list)
-    | Texp_try (exp, list) ->
-        Pexp_try (untype_expression exp,
-          List.map (fun (pat, exp) ->
-              untype_pattern pat, untype_expression exp) list)
+    | Texp_match (exp, cases, _) ->
+        Pexp_match (untype_expression exp, untype_cases cases)
+    | Texp_try (exp, cases) ->
+        Pexp_try (untype_expression exp, untype_cases cases)
     | Texp_tuple list ->
         Pexp_tuple (List.map untype_expression list)
-    | Texp_construct (lid, _, args, explicit_arity) ->
+    | Texp_construct (lid, _, args) ->
         Pexp_construct (lid,
           (match args with
               [] -> None
           | [ arg ] -> Some (untype_expression arg)
-          | args -> Some
-            { pexp_desc = Pexp_tuple (List.map untype_expression args);
-              pexp_loc = exp.exp_loc; }
-          ), explicit_arity)
+          | args ->
+              Some
+                (Exp.tuple ~loc:exp.exp_loc (List.map untype_expression args))
+          ))
     | Texp_variant (label, expo) ->
-        Pexp_variant (label, match expo with
-            None -> None
-          | Some exp -> Some (untype_expression exp))
+        Pexp_variant (label, option untype_expression expo)
     | Texp_record (list, expo) ->
         Pexp_record (List.map (fun (lid, _, exp) ->
               lid, untype_expression exp
           ) list,
-          match expo with
-            None -> None
-          | Some exp -> Some (untype_expression exp))
+          option untype_expression expo)
     | Texp_field (exp, lid, _label) ->
         Pexp_field (untype_expression exp, lid)
     | Texp_setfield (exp1, lid, _label, exp2) ->
@@ -251,9 +274,7 @@ and untype_expression exp =
     | Texp_ifthenelse (exp1, exp2, expo) ->
         Pexp_ifthenelse (untype_expression exp1,
           untype_expression exp2,
-          match expo with
-            None -> None
-          | Some exp -> Some (untype_expression exp))
+          option untype_expression expo)
     | Texp_sequence (exp1, exp2) ->
         Pexp_sequence (untype_expression exp1, untype_expression exp2)
     | Texp_while (exp1, exp2) ->
@@ -262,8 +283,6 @@ and untype_expression exp =
         Pexp_for (name,
           untype_expression exp1, untype_expression exp2,
           dir, untype_expression exp3)
-    | Texp_when (exp1, exp2) ->
-        Pexp_when (untype_expression exp1, untype_expression exp2)
     | Texp_send (exp, meth, _) ->
         Pexp_send (untype_expression exp, match meth with
             Tmeth_name name -> name
@@ -281,7 +300,6 @@ and untype_expression exp =
         Pexp_letmodule (name, untype_module_expr mexpr,
           untype_expression exp)
     | Texp_assert exp -> Pexp_assert (untype_expression exp)
-    | Texp_assertfalse -> Pexp_assertfalse
     | Texp_lazy exp -> Pexp_lazy (untype_expression exp)
     | Texp_object (cl, _) ->
         Pexp_object (untype_class_structure cl)
@@ -289,8 +307,7 @@ and untype_expression exp =
         Pexp_pack (untype_module_expr mexpr)
   in
   List.fold_right untype_extra exp.exp_extra
-    { pexp_loc = exp.exp_loc;
-      pexp_desc = desc }
+    (Exp.mk ~loc:exp.exp_loc ~attrs:exp.exp_attributes desc)
 
 and untype_package_type pack =
   (pack.pack_txt,
@@ -303,45 +320,41 @@ and untype_signature sg =
 and untype_signature_item item =
   let desc =
     match item.sig_desc with
-      Tsig_value (_id, name, v) ->
-        Psig_value (name, untype_value_description v)
+      Tsig_value v ->
+        Psig_value (untype_value_description v)
     | Tsig_type list ->
-        Psig_type (List.map (fun (_id, name, decl) ->
-              name, untype_type_declaration decl
-          ) list)
-    | Tsig_exception (_id, name, decl) ->
-        Psig_exception (name, untype_exception_declaration decl)
-    | Tsig_module (_id, name, mtype) ->
-        Psig_module (name, untype_module_type mtype)
+        Psig_type (List.map untype_type_declaration list)
+    | Tsig_exception decl ->
+        Psig_exception (untype_constructor_declaration decl)
+    | Tsig_module md ->
+        Psig_module {pmd_name = md.md_name; pmd_type = untype_module_type md.md_type; pmd_attributes = md.md_attributes}
     | Tsig_recmodule list ->
-        Psig_recmodule (List.map (fun (_id, name, mtype) ->
-              name, untype_module_type mtype) list)
-    | Tsig_modtype (_id, name, mdecl) ->
-        Psig_modtype (name, untype_modtype_declaration mdecl)
-    | Tsig_open (ovf, _path, lid) -> Psig_open (ovf, lid)
-    | Tsig_include (mty, _) -> Psig_include (untype_module_type mty)
+        Psig_recmodule (List.map (fun md ->
+              {pmd_name = md.md_name; pmd_type = untype_module_type md.md_type;
+               pmd_attributes = md.md_attributes}) list)
+    | Tsig_modtype mtd ->
+        Psig_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; pmtd_attributes=mtd.mtd_attributes}
+    | Tsig_open (ovf, _path, lid, attrs) -> Psig_open (ovf, lid, attrs)
+    | Tsig_include (mty, _, attrs) -> Psig_include (untype_module_type mty, attrs)
     | Tsig_class list ->
         Psig_class (List.map untype_class_description list)
     | Tsig_class_type list ->
         Psig_class_type (List.map untype_class_type_declaration list)
+    | Tsig_attribute x ->
+        Psig_attribute x
   in
   { psig_desc = desc;
     psig_loc = item.sig_loc;
   }
 
-and untype_modtype_declaration mdecl =
-  match mdecl with
-    Tmodtype_abstract -> Pmodtype_abstract
-  | Tmodtype_manifest mtype -> Pmodtype_manifest (untype_module_type mtype)
-
 and untype_class_description cd =
   {
     pci_virt = cd.ci_virt;
     pci_params = cd.ci_params;
     pci_name = cd.ci_id_name;
     pci_expr = untype_class_type cd.ci_expr;
-    pci_variance = cd.ci_variance;
     pci_loc = cd.ci_loc;
+    pci_attributes = cd.ci_attributes;
   }
 
 and untype_class_type_declaration cd =
@@ -350,8 +363,8 @@ and untype_class_type_declaration cd =
     pci_params = cd.ci_params;
     pci_name = cd.ci_id_name;
     pci_expr = untype_class_type cd.ci_expr;
-    pci_variance = cd.ci_variance;
     pci_loc = cd.ci_loc;
+    pci_attributes = cd.ci_attributes;
   }
 
 and untype_module_type mty =
@@ -364,22 +377,20 @@ and untype_module_type mty =
     | Tmty_with (mtype, list) ->
         Pmty_with (untype_module_type mtype,
           List.map (fun (_path, lid, withc) ->
-              lid, untype_with_constraint withc
+              untype_with_constraint lid withc
           ) list)
     | Tmty_typeof mexpr ->
         Pmty_typeof (untype_module_expr mexpr)
   in
-  {
-    pmty_desc = desc;
-    pmty_loc = mty.mty_loc;
-  }
+  Mty.mk ~loc:mty.mty_loc desc
 
-and untype_with_constraint cstr =
+and untype_with_constraint lid cstr =
   match cstr with
-    Twith_type decl -> Pwith_type (untype_type_declaration decl)
-  | Twith_module (_path, lid) -> Pwith_module (lid)
+    Twith_type decl -> Pwith_type (lid, untype_type_declaration decl)
+  | Twith_module (_path, lid2) -> Pwith_module (lid, lid2)
   | Twith_typesubst decl -> Pwith_typesubst (untype_type_declaration decl)
-  | Twith_modsubst (_path, lid) -> Pwith_modsubst (lid)
+  | Twith_modsubst (_path, lid2) ->
+      Pwith_modsubst ({loc = lid.loc; txt=Longident.last lid.txt}, lid2)
 
 and untype_module_expr mexpr =
   match mexpr.mod_desc with
@@ -404,10 +415,7 @@ and untype_module_expr mexpr =
         (* TODO , untype_package_type pack) *)
 
   in
-  {
-    pmod_desc = desc;
-    pmod_loc = mexpr.mod_loc;
-  }
+  Mod.mk ~loc:mexpr.mod_loc desc
 
 and untype_class_expr cexpr =
   let desc = match cexpr.cl_desc with
@@ -429,8 +437,7 @@ and untype_class_expr cexpr =
 
     | Tcl_let (rec_flat, bindings, _ivars, cl) ->
         Pcl_let (rec_flat,
-          List.map (fun (pat, exp) ->
-              (untype_pattern pat, untype_expression exp)) bindings,
+          List.map untype_binding bindings,
           untype_class_expr cl)
 
     | Tcl_constraint (cl, Some clty, _vals, _meths, _concrs) ->
@@ -441,6 +448,7 @@ and untype_class_expr cexpr =
   in
   { pcl_desc = desc;
     pcl_loc = cexpr.cl_loc;
+    pcl_attributes = cexpr.cl_attributes;
   }
 
 and untype_class_type ct =
@@ -448,34 +456,34 @@ and untype_class_type ct =
       Tcty_signature csg -> Pcty_signature (untype_class_signature csg)
     | Tcty_constr (_path, lid, list) ->
         Pcty_constr (lid, List.map untype_core_type list)
-    | Tcty_fun (label, ct, cl) ->
-        Pcty_fun (label, untype_core_type ct, untype_class_type cl)
+    | Tcty_arrow (label, ct, cl) ->
+        Pcty_arrow (label, untype_core_type ct, untype_class_type cl)
   in
   { pcty_desc = desc;
-    pcty_loc = ct.cltyp_loc }
+    pcty_loc = ct.cltyp_loc;
+    pcty_attributes = ct.cltyp_attributes;
+   }
 
 and untype_class_signature cs =
   {
     pcsig_self = untype_core_type cs.csig_self;
     pcsig_fields = List.map untype_class_type_field cs.csig_fields;
-    pcsig_loc = cs.csig_loc;
   }
 
 and untype_class_type_field ctf =
   let desc = match ctf.ctf_desc with
-      Tctf_inher ct -> Pctf_inher (untype_class_type ct)
+      Tctf_inherit ct -> Pctf_inherit (untype_class_type ct)
     | Tctf_val (s, mut, virt, ct) ->
         Pctf_val (s, mut, virt, untype_core_type ct)
-    | Tctf_virt  (s, priv, ct) ->
-        Pctf_virt (s, priv, untype_core_type ct)
-    | Tctf_meth  (s, priv, ct) ->
-        Pctf_meth  (s, priv, untype_core_type ct)
-    | Tctf_cstr  (ct1, ct2) ->
-        Pctf_cstr (untype_core_type ct1, untype_core_type ct2)
+    | Tctf_method  (s, priv, virt, ct) ->
+        Pctf_method  (s, priv, virt, untype_core_type ct)
+    | Tctf_constraint  (ct1, ct2) ->
+        Pctf_constraint (untype_core_type ct1, untype_core_type ct2)
   in
   {
     pctf_desc = desc;
     pctf_loc = ctf.ctf_loc;
+    pctf_attributes = ctf.ctf_attributes;
   }
 
 and untype_core_type ct =
@@ -488,11 +496,10 @@ and untype_core_type ct =
     | Ttyp_constr (_path, lid, list) ->
         Ptyp_constr (lid,
           List.map untype_core_type list)
-    | Ttyp_object list ->
-        Ptyp_object (List.map untype_core_field_type list)
-    | Ttyp_class (_path, lid, list, labels) ->
-        Ptyp_class (lid,
-          List.map untype_core_type list, labels)
+    | Ttyp_object (list, o) ->
+        Ptyp_object (List.map (fun (s, t) -> (s, untype_core_type t)) list, o)
+    | Ttyp_class (_path, lid, list) ->
+        Ptyp_class (lid, List.map untype_core_type list)
     | Ttyp_alias (ct, s) ->
         Ptyp_alias (untype_core_type ct, s)
     | Ttyp_variant (list, bool, labels) ->
@@ -500,16 +507,10 @@ and untype_core_type ct =
     | Ttyp_poly (list, ct) -> Ptyp_poly (list, untype_core_type ct)
     | Ttyp_package pack -> Ptyp_package (untype_package_type pack)
   in
-  { ptyp_desc = desc; ptyp_loc = ct.ctyp_loc }
-
-and untype_core_field_type cft =
-  { pfield_desc = (match cft.field_desc with
-        Tcfield_var -> Pfield_var
-      | Tcfield (s, ct) -> Pfield (s, untype_core_type ct));
-    pfield_loc = cft.field_loc; }
+  Typ.mk ~loc:ct.ctyp_loc desc
 
 and untype_class_structure cs =
-  { pcstr_pat = untype_pattern cs.cstr_pat;
+  { pcstr_self = untype_pattern cs.cstr_self;
     pcstr_fields = List.map untype_class_field cs.cstr_fields;
   }
 
@@ -521,26 +522,18 @@ and untype_row_field rf =
 
 and untype_class_field cf =
   let desc = match cf.cf_desc with
-      Tcf_inher (ovf, cl, super, _vals, _meths) ->
-        Pcf_inher (ovf, untype_class_expr cl, super)
-    | Tcf_constr (cty, cty') ->
-        Pcf_constr (untype_core_type cty, untype_core_type cty')
-    | Tcf_val (_lab, name, mut, _, Tcfk_virtual cty, _override) ->
-        Pcf_valvirt (name, mut, untype_core_type cty)
-    | Tcf_val (_lab, name, mut, _, Tcfk_concrete exp, override) ->
-        Pcf_val (name, mut,
-          (if override then Override else Fresh),
-          untype_expression exp)
-    | Tcf_meth (_lab, name, priv, Tcfk_virtual cty, _override) ->
-        Pcf_virt (name, priv, untype_core_type cty)
-    | Tcf_meth (_lab, name, priv, Tcfk_concrete exp, override) ->
-        Pcf_meth (name, priv,
-          (if override then Override else Fresh),
-          untype_expression exp)
-(*    | Tcf_let (rec_flag, bindings, _) ->
-        Pcf_let (rec_flag, List.map (fun (pat, exp) ->
-              untype_pattern pat, untype_expression exp) bindings)
-*)
-  | Tcf_init exp -> Pcf_init (untype_expression exp)
+      Tcf_inherit (ovf, cl, super, _vals, _meths) ->
+        Pcf_inherit (ovf, untype_class_expr cl, super)
+    | Tcf_constraint (cty, cty') ->
+        Pcf_constraint (untype_core_type cty, untype_core_type cty')
+    | Tcf_val (lab, mut, _, Tcfk_virtual cty, _) ->
+        Pcf_val (lab, mut, Cfk_virtual (untype_core_type cty))
+    | Tcf_val (lab, mut, _, Tcfk_concrete (o, exp), _) ->
+        Pcf_val (lab, mut, Cfk_concrete (o, untype_expression exp))
+    | Tcf_method (lab, priv, Tcfk_virtual cty) ->
+        Pcf_method (lab, priv, Cfk_virtual (untype_core_type cty))
+    | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
+        Pcf_method (lab, priv, Cfk_concrete (o, untype_expression exp))
+    | Tcf_initializer exp -> Pcf_initializer (untype_expression exp)
   in
-  { pcf_desc = desc; pcf_loc = cf.cf_loc }
+  { pcf_desc = desc; pcf_loc = cf.cf_loc; pcf_attributes = cf.cf_attributes }
diff --git a/tools/untypeast.mli b/tools/untypeast.mli
index d61fd4fd5..0e0351ef9 100644
--- a/tools/untypeast.mli
+++ b/tools/untypeast.mli
@@ -13,5 +13,7 @@
 val untype_structure : Typedtree.structure -> Parsetree.structure
 val untype_signature : Typedtree.signature -> Parsetree.signature
 val untype_expression : Typedtree.expression -> Parsetree.expression
+val untype_type_declaration : Typedtree.type_declaration -> Parsetree.type_declaration
+val untype_module_type : Typedtree.module_type -> Parsetree.module_type
 
 val lident_of_path : Path.t -> Longident.t
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 7aea705fa..8b8c659bd 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -20,6 +20,7 @@ open Parsetree
 open Types
 open Typedtree
 open Outcometree
+open Ast_helper
 
 type directive_fun =
    | Directive_none of (unit -> unit)
@@ -113,11 +114,13 @@ let parse_mod_use_file name lb =
          (!parse_use_file lb))
   in
   [ Ptop_def
-      [ { pstr_desc =
-            Pstr_module ( Location.mknoloc modname ,
-                          { pmod_desc = Pmod_structure items;
-                            pmod_loc = Location.none } );
-          pstr_loc = Location.none } ] ]
+      [ Str.module_
+          (Mb.mk
+             (Location.mknoloc modname)
+             (Mod.structure items)
+          )
+       ]
+   ]
 
 (* Hooks for initialization *)
 
@@ -250,7 +253,7 @@ let execute_phrase print_outcome ppf phr =
               if print_outcome then
                 Printtyp.wrap_printing_env oldenv (fun () ->
                   match str.str_items with
-                  | [ { str_desc = Tstr_eval exp }] ->
+                  | [ { str_desc = Tstr_eval (exp, _attrs) }] ->
                       let outv = outval_of_value newenv v exp.exp_type in
                       let ty = Printtyp.tree_of_type_scheme exp.exp_type in
                       Ophr_eval (outv, ty)
diff --git a/typing/btype.ml b/typing/btype.ml
index 4f24372fb..e6458f650 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -367,7 +367,7 @@ let rec unmark_class_type =
       List.iter unmark_type tyl; unmark_class_type cty
   | Cty_signature sign ->
       unmark_class_signature sign
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       unmark_type ty; unmark_class_type cty
 
 
diff --git a/typing/cmt_format.ml b/typing/cmt_format.ml
index 9a0174482..9d117cd3f 100644
--- a/typing/cmt_format.ml
+++ b/typing/cmt_format.ml
@@ -75,8 +75,8 @@ module ClearEnv  = TypedtreeMap.MakeMap (struct
   let leave_pattern p = { p with pat_env = keep_only_summary p.pat_env }
   let leave_expression e =
     let exp_extra = List.map (function
-        (Texp_open (ovf, path, lloc, env), loc) ->
-          (Texp_open (ovf, path, lloc, keep_only_summary env), loc)
+        (Texp_open (ovf, path, lloc, env), loc, attrs) ->
+          (Texp_open (ovf, path, lloc, keep_only_summary env), loc, attrs)
       | exp_extra -> exp_extra) e.exp_extra in
     { e with
       exp_env = keep_only_summary e.exp_env;
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 5789d61f5..ef68a22c9 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -367,7 +367,7 @@ let rec signature_of_class_type =
   function
     Cty_constr (_, _, cty) -> signature_of_class_type cty
   | Cty_signature sign     -> sign
-  | Cty_fun (_, ty, cty)   -> signature_of_class_type cty
+  | Cty_arrow (_, ty, cty)   -> signature_of_class_type cty
 
 let self_type cty =
   repr (signature_of_class_type cty).cty_self
@@ -376,7 +376,7 @@ let rec class_type_arity =
   function
     Cty_constr (_, _, cty) ->  class_type_arity cty
   | Cty_signature _        ->  0
-  | Cty_fun (_, _, cty)    ->  1 + class_type_arity cty
+  | Cty_arrow (_, _, cty)    ->  1 + class_type_arity cty
 
 
                   (*******************************************)
@@ -1141,8 +1141,8 @@ let instance_class params cty =
            cty_concr = sign.cty_concr;
            cty_inher =
              List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher}
-    | Cty_fun (l, ty, cty) ->
-        Cty_fun (l, copy ty, copy_class_type cty)
+    | Cty_arrow (l, ty, cty) ->
+        Cty_arrow (l, copy ty, copy_class_type cty)
   in
   let params' = List.map copy params in
   let cty' = copy_class_type cty in
@@ -3196,7 +3196,7 @@ let rec moregen_clty trace type_pairs env cty1 cty2 =
         moregen_clty true type_pairs env cty1 cty2
     | _, Cty_constr (_, _, cty2) ->
         moregen_clty true type_pairs env cty1 cty2
-    | Cty_fun (l1, ty1, cty1'), Cty_fun (l2, ty2, cty2') when l1 = l2 ->
+    | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
         begin try moregen true type_pairs env ty1 ty2 with Unify trace ->
           raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
         end;
@@ -3331,7 +3331,7 @@ let rec equal_clty trace type_pairs subst env cty1 cty2 =
         equal_clty true type_pairs subst env cty1 cty2
     | _, Cty_constr (_, _, cty2) ->
         equal_clty true type_pairs subst env cty1 cty2
-    | Cty_fun (l1, ty1, cty1'), Cty_fun (l2, ty2, cty2') when l1 = l2 ->
+    | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
         begin try eqtype true type_pairs subst env ty1 ty2 with Unify trace ->
           raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
         end;
@@ -3457,7 +3457,7 @@ let match_class_declarations env patt_params patt_type subj_params subj_type =
         (* Use moregeneral for class parameters, need to recheck everything to
            keeps relationships (PR#4824) *)
         let clty_params =
-          List.fold_right (fun ty cty -> Cty_fun ("*",ty,cty)) in
+          List.fold_right (fun ty cty -> Cty_arrow ("*",ty,cty)) in
         match_class_types ~trace:false env
           (clty_params patt_params patt_type)
           (clty_params subj_params subj_type)
@@ -4180,8 +4180,8 @@ let rec nondep_class_type env id =
                    nondep_class_type env id cty)
   | Cty_signature sign ->
       Cty_signature (nondep_class_signature env id sign)
-  | Cty_fun (l, ty, cty) ->
-      Cty_fun (l, nondep_type_rec env id ty, nondep_class_type env id cty)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, nondep_type_rec env id ty, nondep_class_type env id cty)
 
 let nondep_class_declaration env id decl =
   assert (not (Path.isfree id decl.cty_path));
diff --git a/typing/includeclass.ml b/typing/includeclass.ml
index 2f5aac18b..9e3564b17 100644
--- a/typing/includeclass.ml
+++ b/typing/includeclass.ml
@@ -36,7 +36,7 @@ open Ctype
 
 (*
 let rec hide_params = function
-    Tcty_fun ("*", _, cty) -> hide_params cty
+    Tcty_arrow ("*", _, cty) -> hide_params cty
   | cty -> cty
 *)
 
diff --git a/typing/oprint.ml b/typing/oprint.ml
index b61d26670..31c2ec405 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -305,7 +305,7 @@ let rec print_out_class_type ppf =
             fprintf ppf "@[<1>[%a]@]@ " (print_typlist !out_type ",") tyl
       in
       fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
-  | Octy_fun (lab, ty, cty) ->
+  | Octy_arrow (lab, ty, cty) ->
       fprintf ppf "@[%s%a ->@ %a@]" (if lab <> "" then lab ^ ":" else "")
         print_out_type_2 ty print_out_class_type cty
   | Octy_signature (self_ty, csil) ->
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index 13b0e6f93..19fc1c744 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -66,7 +66,7 @@ and out_variant =
 
 type out_class_type =
   | Octy_constr of out_ident * out_type list
-  | Octy_fun of string * out_type * out_class_type
+  | Octy_arrow of string * out_type * out_class_type
   | Octy_signature of out_type option * out_class_sig_item list
 and out_class_sig_item =
   | Ocsg_constraint of out_type * out_type
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 5490e097d..efca42203 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -23,7 +23,9 @@ open Typedtree
 
 let make_pat desc ty tenv =
   {pat_desc = desc; pat_loc = Location.none; pat_extra = [];
-   pat_type = ty ; pat_env = tenv }
+   pat_type = ty ; pat_env = tenv;
+   pat_attributes = [];
+  }
 
 let omega = make_pat Tpat_any Ctype.none Env.empty
 
@@ -55,6 +57,8 @@ let const_compare x y =
   match x,y with
   | Const_float f1, Const_float f2 ->
       Pervasives.compare (float_of_string f1) (float_of_string f2)
+  | Const_string (s1, _), Const_string (s2, _) ->
+      Pervasives.compare s1 s2
   | _, _ -> Pervasives.compare x y
 
 let records_args l1 l2 =
@@ -84,7 +88,7 @@ let rec compat p q =
   | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
   | Tpat_tuple ps, Tpat_tuple qs -> compats ps qs
   | Tpat_lazy p, Tpat_lazy q -> compat p q
-  | Tpat_construct (_, c1,ps1, _), Tpat_construct (_, c2,ps2, _) ->
+  | Tpat_construct (_, c1,ps1), Tpat_construct (_, c2,ps2) ->
       c1.cstr_tag = c2.cstr_tag && compats ps1 ps2
   | Tpat_variant(l1,Some p1, r1), Tpat_variant(l2,Some p2,_) ->
       l1=l2 && compat p1 p2
@@ -173,7 +177,7 @@ let is_cons tag v  = match get_constr_name tag v.pat_type v.pat_env with
 let pretty_const c = match c with
 | Const_int i -> Printf.sprintf "%d" i
 | Const_char c -> Printf.sprintf "%C" c
-| Const_string s -> Printf.sprintf "%S" s
+| Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
 | Const_int64 i -> Printf.sprintf "%LdL" i
@@ -181,7 +185,7 @@ let pretty_const c = match c with
 
 let rec pretty_val ppf v =
   match v.pat_extra with
-      (cstr,_) :: rem ->
+      (cstr, _loc, _attrs) :: rem ->
         begin match cstr with
           | Tpat_unpack ->
             fprintf ppf "@[(module %a)@]" pretty_val { v with pat_extra = rem }
@@ -197,13 +201,13 @@ let rec pretty_val ppf v =
   | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
   | Tpat_tuple vs ->
       fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
-  | Tpat_construct (_, {cstr_tag=tag},[], _) ->
+  | Tpat_construct (_, {cstr_tag=tag},[]) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       fprintf ppf "%s" name
-  | Tpat_construct (_, {cstr_tag=tag},[w], _) ->
+  | Tpat_construct (_, {cstr_tag=tag},[w]) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       fprintf ppf "@[<2>%s@ %a@]" name pretty_arg w
-  | Tpat_construct (_, {cstr_tag=tag},vs, _) ->
+  | Tpat_construct (_, {cstr_tag=tag},vs) ->
       let name = get_constr_name tag v.pat_type v.pat_env in
       begin match (name, vs) with
         ("::", [v1;v2]) ->
@@ -232,19 +236,19 @@ let rec pretty_val ppf v =
       fprintf ppf "@[(%a|@,%a)@]" pretty_or v pretty_or w
 
 and pretty_car ppf v = match v.pat_desc with
-| Tpat_construct (_,{cstr_tag=tag}, [_ ; _], _)
+| Tpat_construct (_,{cstr_tag=tag}, [_ ; _])
     when is_cons tag v ->
       fprintf ppf "(%a)" pretty_val v
 | _ -> pretty_val ppf v
 
 and pretty_cdr ppf v = match v.pat_desc with
-| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2], _)
+| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2])
     when is_cons tag v ->
       fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
 | _ -> pretty_val ppf v
 
 and pretty_arg ppf v = match v.pat_desc with
-| Tpat_construct (_,_,_::_, _) -> fprintf ppf "(%a)" pretty_val v
+| Tpat_construct (_,_,_::_) -> fprintf ppf "(%a)" pretty_val v
 |  _ -> pretty_val ppf v
 
 and pretty_or ppf v = match v.pat_desc with
@@ -304,7 +308,7 @@ let pretty_matrix (pss : matrix) =
 (* Check top matching *)
 let simple_match p1 p2 =
   match p1.pat_desc, p2.pat_desc with
-  | Tpat_construct(_, c1, _, _), Tpat_construct(_, c2, _, _) ->
+  | Tpat_construct(_, c1, _), Tpat_construct(_, c2, _) ->
       c1.cstr_tag = c2.cstr_tag
   | Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) ->
       l1 = l2
@@ -355,7 +359,7 @@ let all_record_args lbls = match lbls with
 (* Build argument list when p2 >= p1, where p1 is a simple pattern *)
 let rec simple_match_args p1 p2 = match p2.pat_desc with
 | Tpat_alias (p2,_,_) -> simple_match_args p1 p2
-| Tpat_construct(_, cstr, args, _) -> args
+| Tpat_construct(_, cstr, args) -> args
 | Tpat_variant(lab, Some arg, _) -> [arg]
 | Tpat_tuple(args)  -> args
 | Tpat_record(args,_) ->  extract_fields (record_arg p1) args
@@ -363,7 +367,7 @@ let rec simple_match_args p1 p2 = match p2.pat_desc with
 | Tpat_lazy arg -> [arg]
 | (Tpat_any | Tpat_var(_)) ->
     begin match p1.pat_desc with
-      Tpat_construct(_, _,args, _) -> omega_list args
+      Tpat_construct(_, _,args) -> omega_list args
     | Tpat_variant(_, Some _, _) -> [omega]
     | Tpat_tuple(args) -> omega_list args
     | Tpat_record(args,_) ->  omega_list args
@@ -384,9 +388,9 @@ let rec normalize_pat q = match q.pat_desc with
   | Tpat_alias (p,_,_) -> normalize_pat p
   | Tpat_tuple (args) ->
       make_pat (Tpat_tuple (omega_list args)) q.pat_type q.pat_env
-  | Tpat_construct  (lid, c,args,explicit_arity) ->
+  | Tpat_construct  (lid, c,args) ->
       make_pat
-        (Tpat_construct (lid, c,omega_list args, explicit_arity))
+        (Tpat_construct (lid, c,omega_list args))
         q.pat_type q.pat_env
   | Tpat_variant (l, arg, row) ->
       make_pat (Tpat_variant (l, may_map (fun _ -> omega) arg, row))
@@ -471,10 +475,10 @@ let do_set_args erase_mutable q r = match q with
             omegas args, closed))
       q.pat_type q.pat_env::
     rest
-| {pat_desc = Tpat_construct (lid, c,omegas, explicit_arity)} ->
+| {pat_desc = Tpat_construct (lid, c,omegas)} ->
     let args,rest = read_args omegas r in
     make_pat
-      (Tpat_construct (lid, c,args, explicit_arity))
+      (Tpat_construct (lid, c,args))
       q.pat_type q.pat_env::
     rest
 | {pat_desc = Tpat_variant (l, omega, row)} ->
@@ -643,7 +647,7 @@ let row_of_pat pat =
 
 let generalized_constructor x =
   match x with
-    ({pat_desc = Tpat_construct(_,c,_, _);pat_env=env},_) ->
+    ({pat_desc = Tpat_construct(_,c,_);pat_env=env},_) ->
       c.cstr_generalized
   | _ -> assert false
 
@@ -657,9 +661,9 @@ let clean_env env =
   loop env
 
 let full_match ignore_generalized closing env =  match env with
-| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_,_)},_)::_ ->
+| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_)},_)::_ ->
     false
-| ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ ->
+| ({pat_desc = Tpat_construct(_,c,_);pat_type=typ},_) :: _ ->
     if ignore_generalized then
       (* remove generalized constructors;
          those cases will be handled separately *)
@@ -702,12 +706,12 @@ let full_match ignore_generalized closing env =  match env with
 | _ -> fatal_error "Parmatch.full_match"
 
 let full_match_gadt env = match env with
-  | ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ ->
+  | ({pat_desc = Tpat_construct(_,c,_);pat_type=typ},_) :: _ ->
     List.length env = c.cstr_consts + c.cstr_nonconsts
   | _ -> true
 
 let extendable_match env = match env with
-| ({pat_desc=Tpat_construct(_,{cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)}
+| ({pat_desc=Tpat_construct(_,{cstr_tag=(Cstr_constant _|Cstr_block _)},_)}
      as p,_) :: _ ->
     let path = get_type_path p.pat_type p.pat_env in
     not
@@ -721,7 +725,7 @@ let should_extend ext env = match ext with
 | None -> false
 | Some ext -> match env with
   | ({pat_desc =
-      Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)}
+      Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},_)}
      as p, _) :: _ ->
       let path = get_type_path p.pat_type p.pat_env in
       Path.same path ext
@@ -752,7 +756,7 @@ let complete_tags nconsts nconstrs tags =
 let pat_of_constr ex_pat cstr =
  {ex_pat with pat_desc =
   Tpat_construct (mknoloc (Longident.Lident "?pat_of_constr?"),
-                  cstr,omegas cstr.cstr_arity,false)}
+                  cstr,omegas cstr.cstr_arity)}
 
 let rec pat_of_constrs ex_pat = function
 | [] -> raise Empty
@@ -789,7 +793,7 @@ let rec map_filter f  =
 (* Sends back a pattern that complements constructor tags all_tag *)
 let complete_constrs p all_tags =
   match p.pat_desc with
-  | Tpat_construct (_,c,_,_) ->
+  | Tpat_construct (_,c,_) ->
       begin try
         let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
         let (constrs, _) =
@@ -822,22 +826,22 @@ let build_other_constant proj make first next p env =
 
 let build_other ext env =  match env with
 | ({pat_desc =
-    Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_,_)},_)
+    Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_)},_)
   ::_ ->
     make_pat
       (Tpat_construct
          (lid, {c with
            cstr_tag=(Cstr_exception
             (Path.Pident (Ident.create "*exception*"), Location.none))},
-          [], false))
+          []))
       Ctype.none Env.empty
-| ({pat_desc = Tpat_construct (_, _,_,_)} as p,_) :: _ ->
+| ({pat_desc = Tpat_construct (_, _,_)} as p,_) :: _ ->
     begin match ext with
     | Some ext when Path.same ext (get_type_path p.pat_type p.pat_env) ->
         extra_pat
     | _ ->
         let get_tag = function
-          | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag
+          | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag
           | _ -> fatal_error "Parmatch.get_tag" in
         let all_tags =  List.map (fun (p,_) -> get_tag p) env in
         pat_of_constrs p (complete_constrs p all_tags)
@@ -922,9 +926,9 @@ let build_other ext env =  match env with
       0n Nativeint.succ p env
 | ({pat_desc=(Tpat_constant (Const_string _))} as p,_) :: _ ->
     build_other_constant
-      (function Tpat_constant(Const_string s) -> String.length s
+      (function Tpat_constant(Const_string (s, _)) -> String.length s
               | _ -> assert false)
-      (function i -> Tpat_constant(Const_string(String.make i '*')))
+      (function i -> Tpat_constant(Const_string(String.make i '*', None)))
       0 succ p env
 | ({pat_desc=(Tpat_constant (Const_float _))} as p,_) :: _ ->
     build_other_constant
@@ -954,7 +958,7 @@ let build_other_gadt ext env =
   match env with
     | ({pat_desc = Tpat_construct _} as p,_) :: _ ->
         let get_tag = function
-          | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag
+          | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag
           | _ -> fatal_error "Parmatch.get_tag" in
         let all_tags =  List.map (fun (p,_) -> get_tag p) env in
         let cnstrs  = complete_constrs p all_tags in
@@ -978,7 +982,7 @@ let rec has_instance p = match p.pat_desc with
   | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
   | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
   | Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
-  | Tpat_construct (_,_,ps,_) | Tpat_tuple ps | Tpat_array ps ->
+  | Tpat_construct (_,_,ps) | Tpat_tuple ps | Tpat_array ps ->
       has_instances ps
   | Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps)
   | Tpat_lazy p
@@ -1125,7 +1129,7 @@ let print_pat pat =
       | Tpat_any -> "_"
       | Tpat_alias (p, x) -> Printf.sprintf "(%s) as ?"  (string_of_pat p)
       | Tpat_constant n -> "0"
-      | Tpat_construct (_, lid, _, _) ->
+      | Tpat_construct (_, lid, _) ->
         Printf.sprintf "%s" (String.concat "." (Longident.flatten lid.txt))
       | Tpat_lazy p ->
         Printf.sprintf "(lazy %s)" (string_of_pat p)
@@ -1516,7 +1520,7 @@ let rec le_pat p q =
   | Tpat_alias(p,_,_), _ -> le_pat p q
   | _, Tpat_alias(q,_,_) -> le_pat p q
   | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
-  | Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
+  | Tpat_construct(_,c1,ps), Tpat_construct(_,c2,qs) ->
       c1.cstr_tag = c2.cstr_tag && le_pats ps qs
   | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
       (l1 = l2 && le_pat p1 p2)
@@ -1566,10 +1570,10 @@ let rec lub p q = match p.pat_desc,q.pat_desc with
 | Tpat_lazy p, Tpat_lazy q ->
     let r = lub p q in
     make_pat (Tpat_lazy r) p.pat_type p.pat_env
-| Tpat_construct (lid, c1,ps1,_), Tpat_construct (_,c2,ps2,_)
+| Tpat_construct (lid, c1,ps1), Tpat_construct (_,c2,ps2)
       when  c1.cstr_tag = c2.cstr_tag  ->
         let rs = lubs ps1 ps2 in
-        make_pat (Tpat_construct (lid, c1,rs, false))
+        make_pat (Tpat_construct (lid, c1,rs))
           p.pat_type p.pat_env
 | Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_)
           when  l1=l2 ->
@@ -1634,19 +1638,10 @@ let pressure_variants tdefs patl =
   about guarded patterns
 *)
 
-let has_guard act =   match act.exp_desc with
-| Texp_when(_, _) -> true
-| _ -> false
-
-
 let rec initial_matrix = function
     [] -> []
-  | (pat, act) :: rem ->
-      if has_guard act
-      then
-        initial_matrix rem
-      else
-        [pat] :: initial_matrix rem
+  | {c_guard=Some _} :: rem -> initial_matrix rem
+  | {c_guard=None; c_lhs=p} :: rem -> [p] :: initial_matrix rem
 
 (******************************************)
 (* Look for a row that matches some value *)
@@ -1668,8 +1663,8 @@ let rec initial_all no_guard = function
         raise NoGuard
       else
         []
-  | (pat, act) :: rem ->
-      ([pat], pat.pat_loc) :: initial_all (no_guard && not (has_guard act)) rem
+  | {c_lhs=pat; c_guard; _} :: rem ->
+      ([pat], pat.pat_loc) :: initial_all (no_guard && c_guard = None) rem
 
 
 let rec do_filter_var = function
@@ -1732,9 +1727,7 @@ let check_partial_all v casel =
 (* conversion from Typedtree.pattern to Parsetree.pattern list *)
 module Conv = struct
   open Parsetree
-  let mkpat desc =
-    {ppat_desc = desc;
-     ppat_loc = Location.none}
+  let mkpat desc = Ast_helper.Pat.mk desc
 
   let rec select : 'a list list -> 'a list list =
     function
@@ -1772,14 +1765,14 @@ module Conv = struct
           List.map
             (fun lst -> mkpat (Ppat_tuple lst))
             results
-      | Tpat_construct (cstr_lid, cstr,lst,_) ->
+      | Tpat_construct (cstr_lid, cstr,lst) ->
           let id = fresh cstr.cstr_name in
           let lid = { cstr_lid with txt = Longident.Lident id } in
           Hashtbl.add constrs id cstr;
           let results = select (List.map loop lst) in
           begin match lst with
             [] ->
-              [mkpat (Ppat_construct(lid, None, false))]
+              [mkpat (Ppat_construct(lid, None))]
           | _ ->
               List.map
                 (fun lst ->
@@ -1789,7 +1782,7 @@ module Conv = struct
                     | [x] -> Some x
                     | _ -> Some (mkpat (Ppat_tuple lst))
                   in
-                  mkpat (Ppat_construct(lid, arg, false)))
+                  mkpat (Ppat_construct(lid, arg)))
                 results
           end
       | Tpat_variant(label,p_opt,row_desc) ->
@@ -1920,7 +1913,7 @@ let extendable_path path =
     Path.same path Predef.path_option)
 
 let rec collect_paths_from_pat r p = match p.pat_desc with
-| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},ps,_) ->
+| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},ps) ->
     let path =  get_type_path p.pat_type p.pat_env in
     List.fold_left
       collect_paths_from_pat
@@ -1928,7 +1921,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with
       ps
 | Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
 | Tpat_tuple ps | Tpat_array ps
-| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps,_)->
+| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps)->
     List.fold_left collect_paths_from_pat r ps
 | Tpat_record (lps,_) ->
     List.fold_left
@@ -1952,7 +1945,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with
 let do_check_fragile_param exhaust loc casel pss =
   let exts =
     List.fold_left
-      (fun r (p,_) -> collect_paths_from_pat r p)
+      (fun r c -> collect_paths_from_pat r c.c_lhs)
       [] casel in
   match exts with
   | [] -> ()
@@ -1980,7 +1973,7 @@ let check_unused tdefs casel =
   if Warnings.is_active Warnings.Unused_match then
     let rec do_rec pref = function
       | [] -> ()
-      | (q,act)::rem ->
+      | {c_lhs=q; c_guard} :: rem ->
           let qs = [q] in
             begin try
               let pss =
@@ -2000,7 +1993,7 @@ let check_unused tdefs casel =
             with Empty | Not_an_adt | Not_found | NoGuard -> assert false
             end ;
 
-          if has_guard act then
+          if c_guard <> None then
             do_rec pref rem
           else
             do_rec ([q]::pref) rem in
@@ -2022,7 +2015,7 @@ let rec inactive pat = match pat with
     false
 | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) ->
     true
-| Tpat_tuple ps | Tpat_construct (_, _, ps,_) | Tpat_array ps ->
+| Tpat_tuple ps | Tpat_construct (_, _, ps) | Tpat_array ps ->
     List.for_all (fun p -> inactive p.pat_desc) ps
 | Tpat_alias (p,_,_) | Tpat_variant (_, Some p, _) ->
     inactive p.pat_desc
diff --git a/typing/parmatch.mli b/typing/parmatch.mli
index ffb0b906f..947f16fa2 100644
--- a/typing/parmatch.mli
+++ b/typing/parmatch.mli
@@ -53,13 +53,13 @@ val complete_constrs :
     pattern -> constructor_tag list -> constructor_description  list
 
 val pressure_variants: Env.t -> pattern list -> unit
-val check_partial: Location.t -> (pattern * expression) list -> partial
+val check_partial: Location.t -> case list -> partial
 val check_partial_gadt:
     ((string, constructor_description) Hashtbl.t ->
      (string, label_description) Hashtbl.t ->
      Parsetree.pattern -> pattern option) ->
-    Location.t -> (pattern * expression) list -> partial
-val check_unused: Env.t -> (pattern * expression) list -> unit
+    Location.t -> case list -> partial
+val check_unused: Env.t -> case list -> unit
 
 (* Irrefutability tests *)
 val irrefutable : pattern -> bool
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index f8077264f..e3a841f82 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -938,7 +938,7 @@ let rec prepare_class_type params = function
       in
       List.iter (fun met -> mark_loops (fst (method_type met))) fields;
       Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.cty_vars
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       mark_loops ty;
       prepare_class_type params cty
 
@@ -984,7 +984,7 @@ let rec tree_of_class_type sch params =
         List.fold_left (tree_of_metho sch sign.cty_concr) csil fields
       in
       Octy_signature (self_ty, List.rev csil)
-  | Cty_fun (l, ty, cty) ->
+  | Cty_arrow (l, ty, cty) ->
       let lab = if !print_labels && l <> "" || is_optional l then l else "" in
       let ty =
        if is_optional l then
@@ -993,7 +993,7 @@ let rec tree_of_class_type sch params =
          | _ -> newconstr (Path.Pident(Ident.create "<hidden>")) []
        else ty in
       let tr = tree_of_typexp sch ty in
-      Octy_fun (lab, tr, tree_of_class_type sch params cty)
+      Octy_arrow (lab, tr, tree_of_class_type sch params cty)
 
 let class_type ppf cty =
   reset ();
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 840a76736..7861361b8 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -56,7 +56,9 @@ let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
   | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
-  | Const_string (s) -> fprintf f "Const_string %S" s;
+  | Const_string (s, None) -> fprintf f "Const_string(%S,None)" s;
+  | Const_string (s, Some delim) ->
+      fprintf f "Const_string (%S,Some %S)" s delim;
   | Const_float (s) -> fprintf f "Const_float %s" s;
   | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
   | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
@@ -81,11 +83,15 @@ let fmt_override_flag f x =
   | Fresh -> fprintf f "Fresh";
 ;;
 
+let fmt_closed_flag f x =
+  match x with
+  | Closed -> fprintf f "Closed"
+  | Open -> fprintf f "Open"
+
 let fmt_rec_flag f x =
   match x with
   | Nonrecursive -> fprintf f "Nonrec";
   | Recursive -> fprintf f "Rec";
-  | Default -> fprintf f "Default";
 ;;
 
 let fmt_direction_flag f x =
@@ -130,8 +136,18 @@ let string_loc i ppf s = line i ppf "\"%s\"\n" s.txt;;
 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
 
+let attributes i ppf l =
+  let i = i + 1 in
+  List.iter
+    (fun (s, arg) ->
+      line i ppf "attribute \"%s\"\n" s.txt;
+      Printast.payload (i + 1) ppf arg;
+    )
+    l
+
 let rec core_type i ppf x =
   line i ppf "core_type %a\n" fmt_location x.ctyp_loc;
+  attributes i ppf x.ctyp_attributes;
   let i = i+1 in
   match x.ctyp_desc with
   | Ttyp_any -> line i ppf "Ptyp_any\n";
@@ -148,16 +164,21 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_constr %a\n" fmt_path li;
       list i core_type ppf l;
   | Ttyp_variant (l, closed, low) ->
-      line i ppf "Ptyp_variant closed=%s\n" (string_of_bool closed);
+      line i ppf "Ptyp_variant closed=%a\n" fmt_closed_flag closed;
       list i label_x_bool_x_core_type_list ppf l;
       option i (fun i -> list i string) ppf low
-  | Ttyp_object (l) ->
-      line i ppf "Ptyp_object\n";
-      list i core_field_type ppf l;
-  | Ttyp_class (li, _, l, low) ->
+  | Ttyp_object (l, c) ->
+      line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
+      let i = i + 1 in
+      List.iter
+        (fun (s, t) ->
+          line i ppf "method %s" s;
+          core_type (i + 1) ppf t
+        )
+        l
+  | Ttyp_class (li, _, l) ->
       line i ppf "Ptyp_class %a\n" fmt_path li;
       list i core_type ppf l;
-      list i string ppf low
   | Ttyp_alias (ct, s) ->
       line i ppf "Ptyp_alias \"%s\"\n" s;
       core_type i ppf ct;
@@ -173,28 +194,23 @@ and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident s;
   core_type i ppf t
 
-and core_field_type i ppf x =
-  line i ppf "core_field_type %a\n" fmt_location x.field_loc;
-  let i = i+1 in
-  match x.field_desc with
-  | Tcfield (s, ct) ->
-      line i ppf "Pfield \"%s\"\n" s;
-      core_type i ppf ct;
-  | Tcfield_var -> line i ppf "Pfield_var\n";
-
 and pattern i ppf x =
   line i ppf "pattern %a\n" fmt_location x.pat_loc;
+  attributes i ppf x.pat_attributes;
   let i = i+1 in
   match x.pat_extra with
-    | (Tpat_unpack, _) :: rem ->
+    | (Tpat_unpack, _, attrs) :: rem ->
         line i ppf "Tpat_unpack\n";
+        attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
-    | (Tpat_constraint cty, _) :: rem ->
+    | (Tpat_constraint cty, _, attrs) :: rem ->
         line i ppf "Tpat_constraint\n";
+        attributes i ppf attrs;
         core_type i ppf cty;
         pattern i ppf { x with pat_extra = rem }
-    | (Tpat_type (id, _), _) :: rem ->
+    | (Tpat_type (id, _), _, attrs) :: rem ->
         line i ppf "Tpat_type %a\n" fmt_path id;
+        attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
     | [] ->
   match x.pat_desc with
@@ -207,10 +223,9 @@ and pattern i ppf x =
   | Tpat_tuple (l) ->
       line i ppf "Ppat_tuple\n";
       list i pattern ppf l;
-  | Tpat_construct (li, _, po, explicity_arity) ->
+  | Tpat_construct (li, _, po) ->
       line i ppf "Ppat_construct %a\n" fmt_longident li;
       list i pattern ppf po;
-      bool i ppf explicity_arity;
   | Tpat_variant (l, po, _) ->
       line i ppf "Ppat_variant \"%s\"\n" l;
       option i pattern ppf po;
@@ -228,24 +243,33 @@ and pattern i ppf x =
       line i ppf "Ppat_lazy\n";
       pattern i ppf p;
 
-and expression_extra i ppf x =
+and expression_extra i ppf x attrs =
   match x with
-  | Texp_constraint (cto1, cto2) ->
+  | Texp_constraint ct ->
+      line i ppf "Pexp_constraint\n";
+      attributes i ppf attrs;
+      core_type i ppf ct;
+  | Texp_coerce (cto1, cto2) ->
       line i ppf "Pexp_constraint\n";
+      attributes i ppf attrs;
       option i core_type ppf cto1;
-      option i core_type ppf cto2;
+      core_type i ppf cto2;
   | Texp_open (ovf, m, _, _) ->
       line i ppf "Pexp_open %a \"%a\"\n" fmt_override_flag ovf fmt_path m;
+      attributes i ppf attrs;
   | Texp_poly cto ->
       line i ppf "Pexp_poly\n";
+      attributes i ppf attrs;
       option i core_type ppf cto;
   | Texp_newtype s ->
       line i ppf "Pexp_newtype \"%s\"\n" s;
+      attributes i ppf attrs;
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.exp_loc;
+  attributes i ppf x.exp_attributes;
   let i =
-    List.fold_left (fun i (extra,_) -> expression_extra i ppf extra; i+1)
+    List.fold_left (fun i (extra,_,attrs) -> expression_extra i ppf extra attrs; i+1)
       (i+1) x.exp_extra
   in
   match x.exp_desc with
@@ -254,12 +278,12 @@ and expression i ppf x =
   | Texp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
   | Texp_let (rf, l, e) ->
       line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l;
+      list i value_binding ppf l;
       expression i ppf e;
   | Texp_function (p, l, _partial) ->
       line i ppf "Pexp_function \"%s\"\n" p;
 (*      option i expression ppf eo; *)
-      list i pattern_x_expression_case ppf l;
+      list i case ppf l;
   | Texp_apply (e, l) ->
       line i ppf "Pexp_apply\n";
       expression i ppf e;
@@ -267,18 +291,17 @@ and expression i ppf x =
   | Texp_match (e, l, partial) ->
       line i ppf "Pexp_match\n";
       expression i ppf e;
-      list i pattern_x_expression_case ppf l;
+      list i case ppf l;
   | Texp_try (e, l) ->
       line i ppf "Pexp_try\n";
       expression i ppf e;
-      list i pattern_x_expression_case ppf l;
+      list i case ppf l;
   | Texp_tuple (l) ->
       line i ppf "Pexp_tuple\n";
       list i expression ppf l;
-  | Texp_construct (li, _, eo, b) ->
+  | Texp_construct (li, _, eo) ->
       line i ppf "Pexp_construct %a\n" fmt_longident li;
       list i expression ppf eo;
-      bool i ppf b;
   | Texp_variant (l, eo) ->
       line i ppf "Pexp_variant \"%s\"\n" l;
       option i expression ppf eo;
@@ -316,10 +339,6 @@ and expression i ppf x =
       expression i ppf e1;
       expression i ppf e2;
       expression i ppf e3;
-  | Texp_when (e1, e2) ->
-      line i ppf "Pexp_when\n";
-      expression i ppf e1;
-      expression i ppf e2;
   | Texp_send (e, Tmeth_name s, eo) ->
       line i ppf "Pexp_send \"%s\"\n" s;
       expression i ppf e;
@@ -342,8 +361,6 @@ and expression i ppf x =
   | Texp_assert (e) ->
       line i ppf "Pexp_assert";
       expression i ppf e;
-  | Texp_assertfalse ->
-      line i ppf "Pexp_assertfalse";
   | Texp_lazy (e) ->
       line i ppf "Pexp_lazy";
       expression i ppf e;
@@ -355,22 +372,24 @@ and expression i ppf x =
       module_expr i ppf me
 
 and value_description i ppf x =
-  line i ppf "value_description\n";
+  line i ppf "value_description %a %a\n" fmt_ident x.val_id fmt_location x.val_loc;
+  attributes i ppf x.val_attributes;
   core_type (i+1) ppf x.val_desc;
   list (i+1) string ppf x.val_prim;
 
-and string_option_underscore i ppf =
-  function
-    | Some x ->
-        string i ppf x.txt
-    | None ->
-        string i ppf "_"
+and type_parameter i ppf (x, _variance) =
+  match x with
+  | Some x ->
+      string i ppf x.txt
+  | None ->
+      string i ppf "_"
 
 and type_declaration i ppf x =
-  line i ppf "type_declaration %a\n" fmt_location x.typ_loc;
+  line i ppf "type_declaration %a %a\n" fmt_ident x.typ_id fmt_location x.typ_loc;
+  attributes i ppf x.typ_attributes;
   let i = i+1 in
   line i ppf "ptype_params =\n";
-  list (i+1) string_option_underscore ppf x.typ_params;
+  list (i+1) type_parameter ppf x.typ_params;
   line i ppf "ptype_cstrs =\n";
   list (i+1) core_type_x_core_type_x_location ppf x.typ_cstrs;
   line i ppf "ptype_kind =\n";
@@ -385,15 +404,14 @@ and type_kind i ppf x =
       line i ppf "Ptype_abstract\n"
   | Ttype_variant l ->
       line i ppf "Ptype_variant\n";
-      list (i+1) string_x_core_type_list_x_location ppf l;
+      list (i+1) constructor_decl ppf l;
   | Ttype_record l ->
       line i ppf "Ptype_record\n";
-      list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
-
-and exception_declaration i ppf x = list i core_type ppf x
+      list (i+1) label_decl ppf l;
 
 and class_type i ppf x =
   line i ppf "class_type %a\n" fmt_location x.cltyp_loc;
+  attributes i ppf x.cltyp_attributes;
   let i = i+1 in
   match x.cltyp_desc with
   | Tcty_constr (li, _, l) ->
@@ -402,8 +420,8 @@ and class_type i ppf x =
   | Tcty_signature (cs) ->
       line i ppf "Pcty_signature\n";
       class_signature i ppf cs;
-  | Tcty_fun (l, co, cl) ->
-      line i ppf "Pcty_fun \"%s\"\n" l;
+  | Tcty_arrow (l, co, cl) ->
+      line i ppf "Pcty_arrow \"%s\"\n" l;
       core_type i ppf co;
       class_type i ppf cl;
 
@@ -413,35 +431,32 @@ and class_signature i ppf { csig_self = ct; csig_fields = l } =
   list (i+1) class_type_field ppf l;
 
 and class_type_field i ppf x =
-  let loc = x.ctf_loc in
+  line i ppf "class_type_field %a\n" fmt_location x.ctf_loc;
+  let i = i+1 in
+  attributes i ppf x.ctf_attributes;
   match x.ctf_desc with
-  | Tctf_inher (ct) ->
-      line i ppf "Pctf_inher\n";
+  | Tctf_inherit (ct) ->
+      line i ppf "Pctf_inherit\n";
       class_type i ppf ct;
   | Tctf_val (s, mf, vf, ct) ->
-      line i ppf
-        "Pctf_val \"%s\" %a %a %a\n" s
-        fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
+      line i ppf "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf
+           fmt_virtual_flag vf;
       core_type (i+1) ppf ct;
-  | Tctf_virt (s, pf, ct) ->
-      line i ppf
-        "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+  | Tctf_method (s, pf, vf, ct) ->
+      line i ppf "Pctf_method \"%s\" %a %a\n" s fmt_private_flag pf fmt_virtual_flag vf;
       core_type (i+1) ppf ct;
-  | Tctf_meth (s, pf, ct) ->
-      line i ppf
-        "Pctf_meth \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
-      core_type (i+1) ppf ct;
-  | Tctf_cstr (ct1, ct2) ->
-      line i ppf "Pctf_cstr %a\n" fmt_location loc;
-      core_type i ppf ct1;
-      core_type i ppf ct2;
+  | Tctf_constraint (ct1, ct2) ->
+      line i ppf "Pctf_constraint\n";
+      core_type (i+1) ppf ct1;
+      core_type (i+1) ppf ct2;
 
 and class_description i ppf x =
   line i ppf "class_description %a\n" fmt_location x.ci_loc;
+  attributes i ppf x.ci_attributes;
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.ci_params;
+  cl_type_parameters (i+1) ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.ci_expr;
@@ -451,13 +466,14 @@ and class_type_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.ci_params;
+  cl_type_parameters (i+1) ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.ci_expr;
 
 and class_expr i ppf x =
   line i ppf "class_expr %a\n" fmt_location x.cl_loc;
+  attributes i ppf x.cl_attributes;
   let i = i+1 in
   match x.cl_desc with
   | Tcl_ident (li, _, l) ->
@@ -478,7 +494,7 @@ and class_expr i ppf x =
       list i label_x_expression ppf l;
   | Tcl_let (rf, l1, l2, ce) ->
       line i ppf "Pcl_let %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l1;
+      list i value_binding ppf l1;
       list i ident_x_loc_x_expression_def ppf l2;
       class_expr i ppf ce;
   | Tcl_constraint (ce, Some ct, _, _, _) ->
@@ -488,7 +504,7 @@ and class_expr i ppf x =
   | Tcl_constraint (_, None, _, _, _) -> assert false
         (* TODO : is it possible ? see parsetree *)
 
-and class_structure i ppf { cstr_pat = p; cstr_fields = l } =
+and class_structure i ppf { cstr_self = p; cstr_fields = l } =
   line i ppf "class_structure\n";
   pattern (i+1) ppf p;
   list (i+1) class_field ppf l;
@@ -530,13 +546,14 @@ and class_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  string_list_x_location (i+1) ppf x.ci_params;
+  cl_type_parameters (i+1) ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_expr (i+1) ppf x.ci_expr;
 
 and module_type i ppf x =
   line i ppf "module_type %a\n" fmt_location x.mty_loc;
+  attributes i ppf x.mty_attributes;
   let i = i+1 in
   match x.mty_desc with
   | Tmty_ident (li,_) -> line i ppf "Pmty_ident %a\n" fmt_path li;
@@ -561,42 +578,56 @@ and signature_item i ppf x =
   line i ppf "signature_item %a\n" fmt_location x.sig_loc;
   let i = i+1 in
   match x.sig_desc with
-  | Tsig_value (s, _, vd) ->
-      line i ppf "Psig_value \"%a\"\n" fmt_ident s;
+  | Tsig_value vd ->
+      line i ppf "Psig_value\n";
       value_description i ppf vd;
-  | Tsig_type (l) ->
+  | Tsig_type l ->
       line i ppf "Psig_type\n";
-      list i string_x_type_declaration ppf l;
-  | Tsig_exception (s, _, ed) ->
-      line i ppf "Psig_exception \"%a\"\n" fmt_ident s;
-      exception_declaration i ppf ed.exn_params;
-  | Tsig_module (s, _, mt) ->
-      line i ppf "Psig_module \"%a\"\n" fmt_ident s;
-      module_type i ppf mt;
+      list i type_declaration ppf l;
+  | Tsig_exception cd ->
+      line i ppf "Psig_exception\n";
+      constructor_decl i ppf cd
+  | Tsig_module md ->
+      line i ppf "Psig_module \"%a\"\n" fmt_ident md.md_id;
+      attributes i ppf md.md_attributes;
+      module_type i ppf md.md_type
   | Tsig_recmodule decls ->
       line i ppf "Psig_recmodule\n";
-      list i string_x_module_type ppf decls;
-  | Tsig_modtype (s, _, md) ->
-      line i ppf "Psig_modtype \"%a\"\n" fmt_ident s;
-      modtype_declaration i ppf md;
-  | Tsig_open (ovf, li,_) ->
-    line i ppf "Psig_open %a %a\n" fmt_override_flag ovf fmt_path li;
-  | Tsig_include (mt, _) ->
+      list i module_declaration ppf decls;
+  | Tsig_modtype x ->
+      line i ppf "Psig_modtype \"%a\"\n" fmt_ident x.mtd_id;
+      attributes i ppf x.mtd_attributes;
+      modtype_declaration i ppf x.mtd_type
+  | Tsig_open (ovf, li,_,attrs) ->
+      line i ppf "Psig_open %a %a\n" fmt_override_flag ovf  fmt_path li;
+      attributes i ppf attrs
+  | Tsig_include (mt, _, attrs) ->
       line i ppf "Psig_include\n";
-      module_type i ppf mt;
+      attributes i ppf attrs;
+      module_type i ppf mt
   | Tsig_class (l) ->
       line i ppf "Psig_class\n";
       list i class_description ppf l;
   | Tsig_class_type (l) ->
       line i ppf "Psig_class_type\n";
       list i class_type_declaration ppf l;
+  | Tsig_attribute (s, arg) ->
+      line i ppf "Psig_attribute \"%s\"\n" s.txt;
+      Printast.payload i ppf arg
 
-and modtype_declaration i ppf x =
-  match x with
-  | Tmodtype_abstract -> line i ppf "Pmodtype_abstract\n";
-  | Tmodtype_manifest (mt) ->
-      line i ppf "Pmodtype_manifest\n";
-      module_type (i+1) ppf mt;
+and module_declaration i ppf md =
+  line i ppf "%a" fmt_ident md.md_id;
+  attributes i ppf md.md_attributes;
+  module_type (i+1) ppf md.md_type;
+
+and module_binding i ppf x =
+  line i ppf "%a\n" fmt_ident x.mb_id;
+  attributes i ppf x.mb_attributes;
+  module_expr (i+1) ppf x.mb_expr
+
+and modtype_declaration i ppf = function
+  | None -> line i ppf "#abstract"
+  | Some mt -> module_type (i + 1) ppf mt
 
 and with_constraint i ppf x =
   match x with
@@ -611,6 +642,7 @@ and with_constraint i ppf x =
 
 and module_expr i ppf x =
   line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+  attributes i ppf x.mod_attributes;
   let i = i+1 in
   match x.mod_desc with
   | Tmod_ident (li,_) -> line i ppf "Pmod_ident %a\n" fmt_path li;
@@ -643,47 +675,51 @@ and structure_item i ppf x =
   line i ppf "structure_item %a\n" fmt_location x.str_loc;
   let i = i+1 in
   match x.str_desc with
-  | Tstr_eval (e) ->
+  | Tstr_eval (e, attrs) ->
       line i ppf "Pstr_eval\n";
+      attributes i ppf attrs;
       expression i ppf e;
   | Tstr_value (rf, l) ->
       line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
-      list i pattern_x_expression_def ppf l;
-  | Tstr_primitive (s, _, vd) ->
-      line i ppf "Pstr_primitive \"%a\"\n" fmt_ident s;
+      list i value_binding ppf l;
+  | Tstr_primitive vd ->
+      line i ppf "Pstr_primitive\n";
       value_description i ppf vd;
   | Tstr_type l ->
       line i ppf "Pstr_type\n";
-      list i string_x_type_declaration ppf l;
-  | Tstr_exception (s, _, ed) ->
-      line i ppf "Pstr_exception \"%a\"\n" fmt_ident s;
-      exception_declaration i ppf ed.exn_params;
-  | Tstr_exn_rebind (s, _, li, _) ->
+      list i type_declaration ppf l;
+  | Tstr_exception cd ->
+      line i ppf "Pstr_exception\n";
+      constructor_decl i ppf cd;
+  | Tstr_exn_rebind (s, _, li, _, attrs) ->
       line i ppf "Pstr_exn_rebind \"%a\" %a\n" fmt_ident s fmt_path li;
-  | Tstr_module (s, _, me) ->
-      line i ppf "Pstr_module \"%a\"\n" fmt_ident s;
-      module_expr i ppf me;
+      attributes i ppf attrs
+  | Tstr_module x ->
+      line i ppf "Pstr_module\n";
+      module_binding i ppf x
   | Tstr_recmodule bindings ->
       line i ppf "Pstr_recmodule\n";
-      list i string_x_modtype_x_module ppf bindings;
-  | Tstr_modtype (s, _, mt) ->
-      line i ppf "Pstr_modtype \"%a\"\n" fmt_ident s;
-      module_type i ppf mt;
-  | Tstr_open (ovf, li, _) ->
-    line i ppf "Pstr_open %a %a\n" fmt_override_flag ovf fmt_path li;
+      list i module_binding ppf bindings
+  | Tstr_modtype x ->
+      line i ppf "Pstr_modtype \"%a\"\n" fmt_ident x.mtd_id;
+      attributes i ppf x.mtd_attributes;
+      modtype_declaration i ppf x.mtd_type
+  | Tstr_open (ovf, li, _, attrs) ->
+      line i ppf "Pstr_open %a %a\n" fmt_override_flag ovf fmt_path li;
+      attributes i ppf attrs
   | Tstr_class (l) ->
       line i ppf "Pstr_class\n";
       list i class_declaration ppf (List.map (fun (cl, _,_) -> cl) l);
   | Tstr_class_type (l) ->
       line i ppf "Pstr_class_type\n";
       list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
-  | Tstr_include (me, _) ->
+  | Tstr_include (me, _, attrs) ->
       line i ppf "Pstr_include";
-      module_expr i ppf me
-
-and string_x_type_declaration i ppf (s, _, td) =
-  ident i ppf s;
-  type_declaration (i+1) ppf td;
+      attributes i ppf attrs;
+      module_expr i ppf me;
+  | Tstr_attribute (s, arg) ->
+      line i ppf "Pstr_attribute \"%s\"\n" s.txt;
+      Printast.payload i ppf arg
 
 and string_x_module_type i ppf (s, _, mty) =
   ident i ppf s;
@@ -703,32 +739,45 @@ and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
   core_type (i+1) ppf ct1;
   core_type (i+1) ppf ct2;
 
-and string_x_core_type_list_x_location i ppf (s, _, l, r_opt) =
-  line i ppf "\"%a\"\n" fmt_ident s;
-  list (i+1) core_type ppf l;
-(*  option (i+1) core_type ppf r_opt; *)
+and constructor_decl i ppf {cd_id; cd_name = _; cd_args; cd_res; cd_loc; cd_attributes} =
+  line i ppf "%a\n" fmt_location cd_loc;
+  attributes i ppf cd_attributes;
+  line (i+1) ppf "%a\n" fmt_ident cd_id;
+  list (i+1) core_type ppf cd_args;
+  option (i+1) core_type ppf cd_res
 
-and string_x_mutable_flag_x_core_type_x_location i ppf (s, _, mf, ct, loc) =
-  line i ppf "\"%a\" %a %a\n" fmt_ident s fmt_mutable_flag mf fmt_location loc;
-  core_type (i+1) ppf ct;
+and label_decl i ppf {ld_id; ld_name = _; ld_mutable; ld_type; ld_loc; ld_attributes} =
+  line i ppf "%a\n" fmt_location ld_loc;
+  attributes i ppf ld_attributes;
+  line (i+1) ppf "%a\n" fmt_mutable_flag ld_mutable;
+  line (i+1) ppf "%a" fmt_ident ld_id;
+  core_type (i+1) ppf ld_type
+
+and cl_type_parameters i ppf l =
+  line i ppf "<params>\n";
+  list (i+1) cl_type_parameter ppf l;
 
-and string_list_x_location i ppf (l, loc) =
-  line i ppf "<params> %a\n" fmt_location loc;
-  list (i+1) string_loc ppf l;
+and cl_type_parameter i ppf (x, _variance) =
+  string_loc i ppf x
 
 and longident_x_pattern i ppf (li, _, p) =
   line i ppf "%a\n" fmt_longident li;
   pattern (i+1) ppf p;
 
-and pattern_x_expression_case i ppf (p, e) =
+and case i ppf {c_lhs; c_guard; c_rhs} =
   line i ppf "<case>\n";
-  pattern (i+1) ppf  p;
-  expression (i+1) ppf e;
-
-and pattern_x_expression_def i ppf (p, e) =
+  pattern (i+1) ppf c_lhs;
+  begin match c_guard with
+  | None -> ()
+  | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
+  end;
+  expression (i+1) ppf c_rhs;
+
+and value_binding i ppf x =
   line i ppf "<def>\n";
-  pattern (i+1) ppf p;
-  expression (i+1) ppf e;
+  attributes (i+1) ppf x.vb_attributes;
+  pattern (i+1) ppf x.vb_pat;
+  expression (i+1) ppf x.vb_expr
 
 and string_x_expression i ppf (s, _, e) =
   line i ppf "<override> \"%a\"\n" fmt_path s;
diff --git a/typing/subst.ml b/typing/subst.ml
index a8d25fb18..70919b60f 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -212,8 +212,8 @@ let rec class_type s =
       Cty_constr (type_path s p, List.map (typexp s) tyl, class_type s cty)
   | Cty_signature sign ->
       Cty_signature (class_signature s sign)
-  | Cty_fun (l, ty, cty) ->
-      Cty_fun (l, typexp s ty, class_type s cty)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, typexp s ty, class_type s cty)
 
 let class_declaration s decl =
   let decl =
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 3c3915bce..7d5872cd3 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -46,19 +46,14 @@ type error =
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
   | Duplicate of string * string
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
 open Typedtree
 
 let ctyp desc typ env loc =
-  { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env }
-let cltyp desc typ env loc =
-  { cltyp_desc = desc; cltyp_type = typ; cltyp_loc = loc; cltyp_env = env }
-let mkcf desc loc = { cf_desc = desc; cf_loc = loc }
-let mkctf desc loc = { ctf_desc = desc; ctf_loc = loc }
-
-
+  { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env; ctyp_attributes = [] }
 
                        (**********************)
                        (*  Useful constants  *)
@@ -99,7 +94,7 @@ let rec generalize_class_type gen =
       gen sty;
       Vars.iter (fun _ (_, _, ty) -> gen ty) vars;
       List.iter (fun (_,tl) -> List.iter gen tl) inher
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       gen ty;
       generalize_class_type gen cty
 
@@ -124,7 +119,7 @@ let rec constructor_type constr cty =
       constructor_type constr cty
   | Cty_signature sign ->
       constr
-  | Cty_fun (l, ty, cty) ->
+  | Cty_arrow (l, ty, cty) ->
       Ctype.newty (Tarrow (l, ty, constructor_type constr cty, Cok))
 
 let rec class_body cty =
@@ -133,7 +128,7 @@ let rec class_body cty =
       cty (* Only class bodies can be abbreviated *)
   | Cty_signature sign ->
       cty
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       class_body cty
 
 let extract_constraints cty =
@@ -153,8 +148,8 @@ let rec abbreviate_class_type path params cty =
   match cty with
     Cty_constr (_, _, _) | Cty_signature _ ->
       Cty_constr (path, params, cty)
-  | Cty_fun (l, ty, cty) ->
-      Cty_fun (l, ty, abbreviate_class_type path params cty)
+  | Cty_arrow (l, ty, cty) ->
+      Cty_arrow (l, ty, abbreviate_class_type path params cty)
 
 let rec closed_class_type =
   function
@@ -166,7 +161,7 @@ let rec closed_class_type =
       Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema ty && cc)
         sign.cty_vars
         true
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       Ctype.closed_schema ty
         &&
       closed_class_type cty
@@ -187,7 +182,7 @@ let rec limited_generalize rv =
         sign.cty_vars;
       List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
         sign.cty_inher
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       Ctype.limited_generalize rv ty;
       limited_generalize rv cty
 
@@ -297,6 +292,7 @@ let virtual_method val_env meths self_type lab priv sty loc =
   let (_, ty') =
      Ctype.filter_self_method val_env lab priv meths self_type
   in
+  let sty = Ast_helper.Typ.force_poly sty in
   let cty = transl_simple_type val_env false sty in
   let ty = cty.ctyp_type in
   begin
@@ -315,6 +311,7 @@ let declare_method val_env meths self_type lab priv sty loc =
     try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
       raise(Error(loc, val_env, Field_type_mismatch ("method", lab, trace)))
   in
+  let sty = Ast_helper.Typ.force_poly sty in
   match sty.ptyp_desc, priv with
     Ptyp_poly ([],sty'), Public ->
 (* TODO: we moved the [transl_simple_type_univars] outside of the lazy,
@@ -347,15 +344,12 @@ let type_constraint val_env sty sty' loc =
   end;
   (cty, cty')
 
-let make_method self_loc cl_num expr =
-  let mkpat d = { ppat_desc = d; ppat_loc = self_loc } in
-  let mkid s = mkloc s self_loc in
-  { pexp_desc =
-      Pexp_function ("", None,
-                     [mkpat (Ppat_alias (mkpat (Ppat_var (mkid "self-*")),
-                                         mkid ("self-" ^ cl_num))),
-                      expr]);
-    pexp_loc = expr.pexp_loc }
+let make_method loc cl_num expr =
+  let open Ast_helper in
+  let mkid s = mkloc s loc in
+  Exp.fun_ ~loc:expr.pexp_loc "" None
+    (Pat.alias ~loc (Pat.var ~loc (mkid "self-*")) (mkid ("self-" ^ cl_num)))
+    expr
 
 (*******************************)
 
@@ -371,8 +365,9 @@ let add_val env loc lab (mut, virt, ty) val_sig =
 let rec class_type_field env self_type meths
     (fields, val_sig, concr_meths, inher) ctf =
   let loc = ctf.pctf_loc in
+  let mkctf desc = { ctf_desc = desc; ctf_loc = loc; ctf_attributes = ctf.pctf_attributes } in
   match ctf.pctf_desc with
-    Pctf_inher sparent ->
+    Pctf_inherit sparent ->
       let parent = class_type env sparent in
       let inher =
         match parent.cltyp_type with
@@ -385,34 +380,35 @@ let rec class_type_field env self_type meths
       in
       let val_sig =
         Vars.fold (add_val env sparent.pcty_loc) cl_sig.cty_vars val_sig in
-      (mkctf (Tctf_inher parent) loc :: fields,
+      (mkctf (Tctf_inherit parent) :: fields,
        val_sig, concr_meths, inher)
 
   | Pctf_val (lab, mut, virt, sty) ->
       let cty = transl_simple_type env false sty in
       let ty = cty.ctyp_type in
-      (mkctf (Tctf_val (lab, mut, virt, cty)) loc :: fields,
+      (mkctf (Tctf_val (lab, mut, virt, cty)) :: fields,
       add_val env ctf.pctf_loc lab (mut, virt, ty) val_sig, concr_meths, inher)
 
-  | Pctf_virt (lab, priv, sty) ->
-        let cty =
-          declare_method env meths self_type lab priv sty  ctf.pctf_loc
-        in
-        (mkctf (Tctf_virt (lab, priv, cty)) loc :: fields,
-      val_sig, concr_meths, inher)
-
-  | Pctf_meth (lab, priv, sty)  ->
+  | Pctf_method (lab, priv, virt, sty)  ->
       let cty =
         declare_method env meths self_type lab priv sty  ctf.pctf_loc in
-      (mkctf (Tctf_meth (lab, priv, cty)) loc :: fields,
-        val_sig, Concr.add lab concr_meths, inher)
+      let concr_meths =
+        match virt with
+        | Concrete -> Concr.add lab concr_meths
+        | Virtual -> concr_meths
+      in
+      (mkctf (Tctf_method (lab, priv, virt, cty)) :: fields,
+        val_sig, concr_meths, inher)
 
-  | Pctf_cstr (sty, sty') ->
+  | Pctf_constraint (sty, sty') ->
       let (cty, cty') = type_constraint env sty sty'  ctf.pctf_loc in
-      (mkctf (Tctf_cstr (cty, cty')) loc :: fields,
+      (mkctf (Tctf_constraint (cty, cty')) :: fields,
         val_sig, concr_meths, inher)
 
-and class_signature env sty sign loc =
+  | Pctf_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
+
+and class_signature env {pcsig_self=sty; pcsig_fields=sign} =
   let meths = ref Meths.empty in
   let self_cty = transl_simple_type env false sty in
   let self_cty = { self_cty with
@@ -444,11 +440,18 @@ and class_signature env sty sign loc =
   { csig_self = self_cty;
     csig_fields = fields;
     csig_type = cty;
-    csig_loc = loc;
     }
 
 and class_type env scty =
-  let loc = scty.pcty_loc in
+  let cltyp desc typ =
+    {
+     cltyp_desc = desc;
+     cltyp_type = typ;
+     cltyp_loc = scty.pcty_loc;
+     cltyp_env = env;
+     cltyp_attributes = scty.pcty_attributes;
+    }
+  in
   match scty.pcty_desc with
     Pcty_constr (lid, styl) ->
       let (path, decl) = Typetexp.find_class_type env scty.pcty_loc lid.txt in
@@ -473,20 +476,21 @@ and class_type env scty =
         )       styl params
       in
       let typ = Cty_constr (path, params, clty) in
-      cltyp (Tcty_constr ( path, lid , ctys)) typ env loc
+      cltyp (Tcty_constr ( path, lid , ctys)) typ
 
   | Pcty_signature pcsig ->
-      let clsig = class_signature env
-        pcsig.pcsig_self pcsig.pcsig_fields pcsig.pcsig_loc in
+      let clsig = class_signature env pcsig in
       let typ = Cty_signature clsig.csig_type in
-      cltyp (Tcty_signature clsig) typ env loc
+      cltyp (Tcty_signature clsig) typ
 
-  | Pcty_fun (l, sty, scty) ->
+  | Pcty_arrow (l, sty, scty) ->
       let cty = transl_simple_type env false sty in
       let ty = cty.ctyp_type in
       let clty = class_type env scty in
-      let typ = Cty_fun (l, ty, clty.cltyp_type) in
-      cltyp (Tcty_fun (l, cty, clty)) typ env loc
+      let typ = Cty_arrow (l, ty, clty.cltyp_type) in
+      cltyp (Tcty_arrow (l, cty, clty)) typ
+  | Pcty_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
 
 let class_type env scty =
   delayed_meth_specs := [];
@@ -501,8 +505,9 @@ let rec class_field self_loc cl_num self_type meths vars
     (val_env, met_env, par_env, fields, concr_meths, warn_vals, inher, local_meths, local_vals)
   cf =
   let loc = cf.pcf_loc in
+  let mkcf desc = { cf_desc = desc; cf_loc = loc; cf_attributes = cf.pcf_attributes } in
   match cf.pcf_desc with
-    Pcf_inher (ovf, sparent, super) ->
+    Pcf_inherit (ovf, sparent, super) ->
       let parent = class_expr cl_num val_env par_env sparent in
       let inher =
         match parent.cl_type with
@@ -544,11 +549,11 @@ let rec class_field self_loc cl_num self_type meths vars
             (val_env, met_env, par_env)
       in
       (val_env, met_env, par_env,
-       lazy (mkcf (Tcf_inher (ovf, parent, super, inh_vars, inh_meths)) loc)
+       lazy (mkcf (Tcf_inherit (ovf, parent, super, inh_vars, inh_meths)))
        :: fields,
        concr_meths, warn_vals, inher, local_meths, local_vals)
 
-  | Pcf_valvirt (lab, mut, styp) ->
+  | Pcf_val (lab, mut, Cfk_virtual styp) ->
       if !Clflags.principal then Ctype.begin_def ();
       let cty = Typetexp.transl_simple_type val_env false styp in
       let ty = cty.ctyp_type in
@@ -561,12 +566,12 @@ let rec class_field self_loc cl_num self_type meths vars
           val_env met_env par_env loc
       in
       (val_env, met_env', par_env,
-       lazy (mkcf (Tcf_val (lab.txt, lab, mut, id, Tcfk_virtual cty,
-                            met_env' == met_env)) loc)
-       :: fields,
-       concr_meths, warn_vals, inher, local_meths, local_vals)
+       lazy (mkcf (Tcf_val (lab, mut, id, Tcfk_virtual cty,
+                            met_env == met_env')))
+             :: fields,
+             concr_meths, warn_vals, inher, local_meths, local_vals)
 
-  | Pcf_val (lab, mut, ovf, sexp) ->
+  | Pcf_val (lab, mut, Cfk_concrete (ovf, sexp)) ->
       if Concr.mem lab.txt local_vals then
         raise(Error(loc, val_env, Duplicate ("instance variable", lab.txt)));
       if Concr.mem lab.txt warn_vals then begin
@@ -592,20 +597,25 @@ let rec class_field self_loc cl_num self_type meths vars
           val_env met_env par_env loc
       in
       (val_env, met_env', par_env,
-       lazy (mkcf (Tcf_val (lab.txt, lab, mut, id,
-                            Tcfk_concrete exp, met_env' == met_env)) loc)
+       lazy (mkcf (Tcf_val (lab, mut, id,
+                            Tcfk_concrete (ovf, exp), met_env == met_env')))
        :: fields,
        concr_meths, Concr.add lab.txt warn_vals, inher, local_meths,
        Concr.add lab.txt local_vals)
 
-  | Pcf_virt (lab, priv, sty) ->
+  | Pcf_method (lab, priv, Cfk_virtual sty) ->
       let cty = virtual_method val_env meths self_type lab.txt priv sty loc in
       (val_env, met_env, par_env,
-        lazy (mkcf(Tcf_meth (lab.txt, lab, priv, Tcfk_virtual cty, true)) loc)
+        lazy (mkcf(Tcf_method (lab, priv, Tcfk_virtual cty)))
        ::fields,
         concr_meths, warn_vals, inher, local_meths, local_vals)
 
-  | Pcf_meth (lab, priv, ovf, expr)  ->
+  | Pcf_method (lab, priv, Cfk_concrete (ovf, expr))  ->
+      let expr =
+        match expr.pexp_desc with
+        | Pexp_poly _ -> expr
+        | _ -> Ast_helper.Exp.poly ~loc:expr.pexp_loc expr None
+      in
       if Concr.mem lab.txt local_meths then
         raise(Error(loc, val_env, Duplicate ("method", lab.txt)));
       if Concr.mem lab.txt concr_meths then begin
@@ -622,6 +632,7 @@ let rec class_field self_loc cl_num self_type meths vars
         Pexp_poly (sbody, sty) ->
           begin match sty with None -> ()
                 | Some sty ->
+                    let sty = Ast_helper.Typ.force_poly sty in
                     let cty' = Typetexp.transl_simple_type val_env false sty in
                     let ty' = cty'.ctyp_type in
               Ctype.unify val_env ty' ty
@@ -654,22 +665,19 @@ let rec class_field self_loc cl_num self_type meths vars
           vars := vars_local;
           let texp = type_expect met_env meth_expr meth_type in
           Ctype.end_def ();
-          mkcf (Tcf_meth (lab.txt, lab, priv, Tcfk_concrete texp,
-              match ovf with
-                Override -> true
-              | Fresh -> false)) loc
+          mkcf (Tcf_method (lab, priv, Tcfk_concrete (ovf, texp)))
         end in
       (val_env, met_env, par_env, field::fields,
        Concr.add lab.txt concr_meths, warn_vals, inher,
        Concr.add lab.txt local_meths, local_vals)
 
-  | Pcf_constr (sty, sty') ->
+  | Pcf_constraint (sty, sty') ->
       let (cty, cty') = type_constraint val_env sty sty' loc in
       (val_env, met_env, par_env,
-        lazy (mkcf (Tcf_constr (cty, cty')) loc) :: fields,
+        lazy (mkcf (Tcf_constraint (cty, cty'))) :: fields,
         concr_meths, warn_vals, inher, local_meths, local_vals)
 
-  | Pcf_init expr ->
+  | Pcf_initializer expr ->
       let expr = make_method self_loc cl_num expr in
       let vars_local = !vars in
       let field =
@@ -682,13 +690,16 @@ let rec class_field self_loc cl_num self_type meths vars
           vars := vars_local;
           let texp = type_expect met_env expr meth_type in
           Ctype.end_def ();
-          mkcf (Tcf_init texp) loc
+          mkcf (Tcf_initializer texp)
         end in
       (val_env, met_env, par_env, field::fields, concr_meths, warn_vals,
        inher, local_meths, local_vals)
 
+  | Pcf_extension (s, _arg) ->
+      raise (Error (s.loc, val_env, Extension s.txt))
+
 and class_structure cl_num final val_env met_env loc
-  { pcstr_pat = spat; pcstr_fields = str } =
+  { pcstr_self = spat; pcstr_fields = str } =
   (* Environment for substructures *)
   let par_env = met_env in
 
@@ -801,7 +812,7 @@ and class_structure cl_num final val_env met_env loc
   let sign = if final then sign else
       {sign with cty_self = Ctype.expand_head val_env public_self} in
   {
-    cstr_pat = pat;
+    cstr_self = pat;
     cstr_fields = fields;
     cstr_type = sign;
     cstr_meths = meths}, sign (* redondant, since already in cstr_type *)
@@ -834,44 +845,54 @@ and class_expr cl_num val_env met_env scl =
         rc {cl_desc = Tcl_ident (path, lid, tyl);
             cl_loc = scl.pcl_loc;
             cl_type = clty';
-            cl_env = val_env}
+            cl_env = val_env;
+            cl_attributes = scl.pcl_attributes;
+           }
       in
       let (vals, meths, concrs) = extract_constraints clty in
       rc {cl_desc = Tcl_constraint (cl, None, vals, meths, concrs);
           cl_loc = scl.pcl_loc;
           cl_type = clty';
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = []; (* attributes are kept on the inner cl node *)
+         }
   | Pcl_structure cl_str ->
       let (desc, ty) =
         class_structure cl_num false val_env met_env scl.pcl_loc cl_str in
       rc {cl_desc = Tcl_structure desc;
           cl_loc = scl.pcl_loc;
           cl_type = Cty_signature ty;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_fun (l, Some default, spat, sbody) ->
       let loc = default.pexp_loc in
-      let scases =
-        [{ppat_loc = loc; ppat_desc = Ppat_construct (
-          mknoloc (Longident.(Ldot (Lident"*predef*", "Some"))),
-          Some{ppat_loc = loc; ppat_desc = Ppat_var (mknoloc "*sth*")},
-          false)},
-         {pexp_loc = loc; pexp_desc =
-          Pexp_ident(mknoloc (Longident.Lident"*sth*"))};
-         {ppat_loc = loc; ppat_desc =
-          Ppat_construct(mknoloc (Longident.(Ldot (Lident"*predef*", "None"))),
-                         None, false)},
-         default] in
+      let open Ast_helper in
+      let scases = [
+        Exp.case
+          (Pat.construct ~loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
+             (Some (Pat.var ~loc (mknoloc "*sth*"))))
+          (Exp.ident ~loc (mknoloc (Longident.Lident "*sth*")));
+
+        Exp.case
+          (Pat.construct ~loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
+             None)
+          default;
+       ]
+      in
       let smatch =
-        {pexp_loc = loc; pexp_desc =
-         Pexp_match({pexp_loc = loc; pexp_desc =
-                     Pexp_ident(mknoloc (Longident.Lident"*opt*"))},
-                    scases)} in
+        Exp.match_ ~loc (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
+          scases
+      in
       let sfun =
-        {pcl_loc = scl.pcl_loc; pcl_desc =
-         Pcl_fun(l, None,
-                 {ppat_loc = loc; ppat_desc = Ppat_var (mknoloc "*opt*")},
-                 {pcl_loc = scl.pcl_loc; pcl_desc =
-                  Pcl_let(Default, [spat, smatch], sbody)})}
+        Cl.fun_ ~loc:scl.pcl_loc
+          l None
+          (Pat.var ~loc (mknoloc "*opt*"))
+          (Cl.let_ ~loc:scl.pcl_loc Nonrecursive [Vb.mk spat smatch] sbody)
+          (* Note: we don't put the '#default' attribute, as it
+             is not detected for class-level let bindings.  See #5975.*)
       in
       class_expr cl_num val_env met_env sfun
   | Pcl_fun (l, None, spat, scl') ->
@@ -894,21 +915,25 @@ and class_expr cl_num val_env met_env scl =
               Texp_ident(path, mknoloc (Longident.Lident (Ident.name id)), vd);
               exp_loc = Location.none; exp_extra = [];
               exp_type = Ctype.instance val_env' vd.val_type;
+              exp_attributes = []; (* check *)
               exp_env = val_env'})
           end
           pv
       in
       let not_function = function
-          Cty_fun _ -> false
+          Cty_arrow _ -> false
         | _ -> true
       in
       let partial =
         Parmatch.check_partial pat.pat_loc
-          [pat, (* Dummy expression *)
-           {exp_desc = Texp_constant (Asttypes.Const_int 1);
-            exp_loc = Location.none; exp_extra = [];
-            exp_type = Ctype.none;
-            exp_env = Env.empty }]
+          [{c_lhs=pat;
+            c_guard=None;
+            c_rhs = (* Dummy expression *)
+            {exp_desc = Texp_constant (Asttypes.Const_int 1);
+             exp_loc = Location.none; exp_extra = [];
+             exp_type = Ctype.none;
+             exp_attributes = [];
+             exp_env = Env.empty }}]
       in
       Ctype.raise_nongen_level ();
       let cl = class_expr cl_num val_env' met_env scl' in
@@ -918,9 +943,11 @@ and class_expr cl_num val_env met_env scl =
           Warnings.Unerasable_optional_argument;
       rc {cl_desc = Tcl_fun (l, pat, pv, cl, partial);
           cl_loc = scl.pcl_loc;
-          cl_type = Cty_fun
+          cl_type = Cty_arrow
             (l, Ctype.instance_def pat.pat_type, cl.cl_type);
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_apply (scl', sargs) ->
       if !Clflags.principal then Ctype.begin_def ();
       let cl = class_expr cl_num val_env met_env scl' in
@@ -930,7 +957,7 @@ and class_expr cl_num val_env met_env scl =
       end;
       let rec nonopt_labels ls ty_fun =
         match ty_fun with
-        | Cty_fun (l, _, ty_res) ->
+        | Cty_arrow (l, _, ty_res) ->
             if Btype.is_optional l then nonopt_labels ls ty_res
             else nonopt_labels (l::ls) ty_res
         | _    -> ls
@@ -948,7 +975,7 @@ and class_expr cl_num val_env met_env scl =
       in
       let rec type_args args omitted ty_fun ty_fun0 sargs more_sargs =
         match ty_fun, ty_fun0 with
-        | Cty_fun (l, ty, ty_fun), Cty_fun (_, ty0, ty_fun0)
+        | Cty_arrow (l, ty, ty_fun), Cty_arrow (_, ty0, ty_fun0)
           when sargs <> [] || more_sargs <> [] ->
             let name = Btype.label_name l
             and optional =
@@ -1009,7 +1036,7 @@ and class_expr cl_num val_env met_env scl =
             | [] ->
                 (List.rev args,
                  List.fold_left
-                   (fun ty_fun (l,ty) -> Cty_fun(l,ty,ty_fun))
+                   (fun ty_fun (l,ty) -> Cty_arrow(l,ty,ty_fun))
                    ty_fun0 omitted)
       in
       let (args, cty) =
@@ -1022,7 +1049,9 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_apply (cl, args);
           cl_loc = scl.pcl_loc;
           cl_type = cty;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_let (rec_flag, sdefs, scl') ->
       let (defs, val_env) =
         try
@@ -1042,6 +1071,7 @@ and class_expr cl_num val_env met_env scl =
                 Texp_ident(path, mknoloc(Longident.Lident (Ident.name id)),vd);
                 exp_loc = Location.none; exp_extra = [];
                 exp_type = Ctype.instance val_env vd.val_type;
+                exp_attributes = [];
                 exp_env = val_env;
                }
              in
@@ -1064,7 +1094,9 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_let (rec_flag, defs, vals, cl);
           cl_loc = scl.pcl_loc;
           cl_type = cl.cl_type;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_constraint (scl', scty) ->
       Ctype.begin_class_def ();
       let context = Typetexp.narrow () in
@@ -1090,7 +1122,11 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_constraint (cl, Some clty, vals, meths, concrs);
           cl_loc = scl.pcl_loc;
           cl_type = snd (Ctype.instance_class [] clty.cltyp_type);
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_extension (s, _arg) ->
+      raise (Error (s.loc, val_env, Extension s.txt))
 
 (*******************************)
 
@@ -1114,7 +1150,7 @@ let rec approx_declaration cl =
 
 let rec approx_description ct =
   match ct.pcty_desc with
-    Pcty_fun (l, _, ct) ->
+    Pcty_arrow (l, _, ct) ->
       let arg =
         if Btype.is_optional l then Ctype.instance_def var_option
         else Ctype.newvar () in
@@ -1147,7 +1183,7 @@ let temp_abbrev loc env id arity =
 let initial_env define_class approx
     (res, env) (cl, id, ty_id, obj_id, cl_id) =
   (* Temporary abbreviations *)
-  let arity = List.length (fst cl.pci_params) in
+  let arity = List.length cl.pci_params in
   let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity in
   let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity in
 
@@ -1201,10 +1237,9 @@ let class_infos define_class kind
   (* Introduce class parameters *)
   let params =
     try
-      let params, loc = cl.pci_params in
-      List.map (fun x -> enter_type_variable true loc x.txt) params
-    with Already_bound ->
-      raise(Error(snd cl.pci_params, env, Repeated_parameter))
+      List.map (fun (x, _v) -> enter_type_variable x) cl.pci_params
+    with Already_bound loc ->
+      raise(Error(loc, env, Repeated_parameter))
   in
 
   (* Allow self coercions (only for class declarations) *)
@@ -1413,19 +1448,19 @@ let final_decl env define_class
 
   (id, cl.pci_name, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
    arity, pub_meths, coe, expr,
-   { ci_variance = cl.pci_variance;
-     ci_loc = cl.pci_loc;
+   { ci_loc = cl.pci_loc;
      ci_virt = cl.pci_virt;
-      ci_params = cl.pci_params;
+     ci_params = cl.pci_params;
 (* TODO : check that we have the correct use of identifiers *)
-      ci_id_name = cl.pci_name;
-      ci_id_class = id;
-      ci_id_class_type = ty_id;
-      ci_id_object = obj_id;
-      ci_id_typesharp = cl_id;
+     ci_id_name = cl.pci_name;
+     ci_id_class = id;
+     ci_id_class_type = ty_id;
+     ci_id_object = obj_id;
+     ci_id_typesharp = cl_id;
      ci_expr = expr;
      ci_decl = clty;
      ci_type_decl = cltydef;
+     ci_attributes = cl.pci_attributes;
  })
 (*   (cl.pci_variance, cl.pci_loc)) *)
 
@@ -1553,7 +1588,7 @@ let rec unify_parents env ty cl =
   | Tcl_constraint (cl, _, _, _, _) -> unify_parents env ty cl
 and unify_parents_struct env ty st =
   List.iter
-    (function {cf_desc = Tcf_inher (_, cl, _, _, _)} -> unify_parents env ty cl
+    (function {cf_desc = Tcf_inherit (_, cl, _, _, _)} -> unify_parents env ty cl
       | _ -> ())
     st.cstr_fields
 
@@ -1575,12 +1610,9 @@ let () =
 
 (* Approximate the class declaration as class ['params] id = object end *)
 let approx_class sdecl =
-  let self' =
-    { ptyp_desc = Ptyp_any; ptyp_loc = Location.none } in
-  let clty' =
-    { pcty_desc = Pcty_signature { pcsig_self = self';
-        pcsig_fields = []; pcsig_loc = Location.none };
-      pcty_loc = sdecl.pci_expr.pcty_loc } in
+  let open Ast_helper in
+  let self' = Typ.any () in
+  let clty' = Cty.signature ~loc:sdecl.pci_expr.pcty_loc (Csig.mk self' []) in
   { sdecl with pci_expr = clty' }
 
 let approx_class_declarations env sdecls =
@@ -1746,6 +1778,8 @@ let report_error env ppf = function
   | Duplicate (kind, name) ->
       fprintf ppf "@[The %s `%s'@ has multiple definitions in this object@]"
                     kind name
+  | Extension s ->
+      fprintf ppf "Uninterpreted extension '%s'." s
 
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error env ppf err)
diff --git a/typing/typeclass.mli b/typing/typeclass.mli
index 8ad203882..abc8633bc 100644
--- a/typing/typeclass.mli
+++ b/typing/typeclass.mli
@@ -104,6 +104,7 @@ type error =
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
   | Duplicate of string * string
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 5e3fa218a..1860f178e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -63,6 +63,8 @@ type error =
   | Recursive_local_constraint of (type_expr * type_expr) list
   | Unexpected_existential
   | Unqualified_gadt_pattern of Path.t * string
+  | Invalid_interval
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
@@ -109,6 +111,9 @@ let rp node =
 let fst3 (x, _, _) = x
 let snd3 (_,x,_) = x
 
+let case lhs rhs =
+  {c_lhs = lhs; c_guard = None; c_rhs = rhs}
+
 (* Upper approximation of free identifiers on the parse tree *)
 
 let iter_expression f e =
@@ -116,19 +121,19 @@ let iter_expression f e =
   let rec expr e =
     f e;
     match e.pexp_desc with
+    | Pexp_extension _ (* we don't iterate under extension point *)
     | Pexp_ident _
-    | Pexp_assertfalse
     | Pexp_new _
     | Pexp_constant _ -> ()
-    | Pexp_function (_, eo, pel) ->
-        may expr eo; List.iter (fun (_, e) -> expr e) pel
+    | Pexp_function pel -> List.iter case pel
+    | Pexp_fun (_, eo, _, e) -> may expr eo; expr e
     | Pexp_apply (e, lel) -> expr e; List.iter (fun (_, e) -> expr e) lel
-    | Pexp_let (_, pel, e)
+    | Pexp_let (_, pel, e) ->  expr e; List.iter binding pel
     | Pexp_match (e, pel)
-    | Pexp_try (e, pel) -> expr e; List.iter (fun (_, e) -> expr e) pel
+    | Pexp_try (e, pel) -> expr e; List.iter case pel
     | Pexp_array el
     | Pexp_tuple el -> List.iter expr el
-    | Pexp_construct (_, eo, _)
+    | Pexp_construct (_, eo)
     | Pexp_variant (_, eo) -> may expr eo
     | Pexp_record (iel, eo) ->
         may expr eo; List.iter (fun (_, e) -> expr e) iel
@@ -139,9 +144,9 @@ let iter_expression f e =
     | Pexp_assert e
     | Pexp_setinstvar (_, e)
     | Pexp_send (e, _)
-    | Pexp_constraint (e, _, _)
+    | Pexp_constraint (e, _)
+    | Pexp_coerce (e, _, _)
     | Pexp_field (e, _) -> expr e
-    | Pexp_when (e1, e2)
     | Pexp_while (e1, e2)
     | Pexp_sequence (e1, e2)
     | Pexp_setfield (e1, _, e2) -> expr e1; expr e2
@@ -152,8 +157,16 @@ let iter_expression f e =
     | Pexp_object { pcstr_fields = fs } -> List.iter class_field fs
     | Pexp_pack me -> module_expr me
 
+  and case {pc_lhs = _; pc_guard; pc_rhs} =
+    may expr pc_guard;
+    expr pc_rhs
+
+  and binding x =
+    expr x.pvb_expr
+
   and module_expr me =
     match me.pmod_desc with
+    | Pmod_extension _
     | Pmod_ident _ -> ()
     | Pmod_structure str -> List.iter structure_item str
     | Pmod_constraint (me, _)
@@ -161,20 +174,23 @@ let iter_expression f e =
     | Pmod_apply (me1, me2) -> module_expr me1; module_expr me2
     | Pmod_unpack e -> expr e
 
+
   and structure_item str =
     match str.pstr_desc with
-    | Pstr_eval e -> expr e
-    | Pstr_value (_, pel) -> List.iter (fun (_, e) -> expr e) pel
+    | Pstr_eval (e, _) -> expr e
+    | Pstr_value (_, pel) -> List.iter binding pel
     | Pstr_primitive _
     | Pstr_type _
     | Pstr_exception _
     | Pstr_modtype _
     | Pstr_open _
     | Pstr_class_type _
+    | Pstr_attribute _
+    | Pstr_extension _
     | Pstr_exn_rebind _ -> ()
-    | Pstr_include me
-    | Pstr_module (_, me) -> module_expr me
-    | Pstr_recmodule l -> List.iter (fun (_, _, me) -> module_expr me) l
+    | Pstr_include (me, _)
+    | Pstr_module {pmb_expr = me} -> module_expr me
+    | Pstr_recmodule l -> List.iter (fun x -> module_expr x.pmb_expr) l
     | Pstr_class cdl -> List.iter (fun c -> class_expr c.pci_expr) cdl
 
   and class_expr ce =
@@ -185,28 +201,37 @@ let iter_expression f e =
     | Pcl_apply (ce, lel) ->
         class_expr ce; List.iter (fun (_, e) -> expr e) lel
     | Pcl_let (_, pel, ce) ->
-        List.iter (fun (_, e) -> expr e) pel; class_expr ce
+        List.iter binding pel; class_expr ce
     | Pcl_constraint (ce, _) -> class_expr ce
+    | Pcl_extension _ -> ()
 
   and class_field cf =
     match cf.pcf_desc with
-    | Pcf_inher (_, ce, _) -> class_expr ce
-    | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _ -> ()
-    | Pcf_val (_,_,_,e) | Pcf_meth (_,_,_,e) -> expr e
-    | Pcf_init e -> expr e
+    | Pcf_inherit (_, ce, _) -> class_expr ce
+    | Pcf_val (_, _, Cfk_virtual _)
+    | Pcf_method (_, _, Cfk_virtual _ ) | Pcf_constraint _ -> ()
+    | Pcf_val (_, _, Cfk_concrete (_, e))
+    | Pcf_method (_, _, Cfk_concrete (_, e)) -> expr e
+    | Pcf_initializer e -> expr e
+    | Pcf_extension _ -> ()
 
   in
   expr e
 
 
-let all_idents el =
+let all_idents_cases el =
   let idents = Hashtbl.create 8 in
   let f = function
     | {pexp_desc=Pexp_ident { txt = Longident.Lident id; _ }; _} ->
         Hashtbl.replace idents id ()
     | _ -> ()
   in
-  List.iter (iter_expression f) el;
+  List.iter
+    (fun cp ->
+      may (iter_expression f) cp.pc_guard;
+      iter_expression f cp.pc_rhs
+    )
+    el;
   Hashtbl.fold (fun x () rest -> x :: rest) idents []
 
 
@@ -227,18 +252,18 @@ let type_option ty =
   newty (Tconstr(Predef.path_option,[ty], ref Mnil))
 
 let mkexp exp_desc exp_type exp_loc exp_env =
-  { exp_desc; exp_type; exp_loc; exp_env; exp_extra = [] }
+  { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
 
 let option_none ty loc =
   let lid = Longident.Lident "None" in
   let cnone = Env.lookup_constructor lid Env.initial in
-  mkexp (Texp_construct(mknoloc lid, cnone, [], false))
+  mkexp (Texp_construct(mknoloc lid, cnone, []))
     ty loc Env.initial
 
 let option_some texp =
   let lid = Longident.Lident "Some" in
   let csome = Env.lookup_constructor lid Env.initial in
-  mkexp ( Texp_construct(mknoloc lid , csome, [texp],false) )
+  mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
     (type_option texp.exp_type) texp.exp_loc texp.exp_env
 
 let extract_option_type env ty =
@@ -432,7 +457,7 @@ let rec build_as_type env p =
   | Tpat_tuple pl ->
       let tyl = List.map (build_as_type env) pl in
       newty (Ttuple tyl)
-  | Tpat_construct(_, cstr, pl,_) ->
+  | Tpat_construct(_, cstr, pl) ->
       let keep = cstr.cstr_private = Private || cstr.cstr_existentials <> [] in
       if keep then p.pat_type else
       let tyl = List.map (build_as_type env) pl in
@@ -498,7 +523,7 @@ let build_or_pat env loc lid =
             (l, Reither(true,[], true, ref None)) :: fields
         | Rpresent (Some ty) ->
             (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
-                      pat_type=ty; pat_extra=[];})
+                      pat_type=ty; pat_extra=[]; pat_attributes=[]})
             :: pats,
             (l, Reither(false, [ty], true, ref None)) :: fields
         | _ -> pats, fields)
@@ -512,7 +537,7 @@ let build_or_pat env loc lid =
   let row' = ref {row with row_more=newvar()} in
   let pats =
     List.map (fun (l,p) -> {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc;
-                            pat_env=env; pat_type=ty; pat_extra=[];})
+                            pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]})
       pats
   in
   match pats with
@@ -521,7 +546,7 @@ let build_or_pat env loc lid =
       let r =
         List.fold_left
           (fun pat pat0 -> {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[];
-                            pat_loc=gloc; pat_env=env; pat_type=ty})
+                            pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]})
           pat pats in
       (path, rp { r with pat_loc = loc },ty)
 
@@ -872,6 +897,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_any;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_var name ->
       let id = enter_variable loc name expected_ty in
@@ -879,14 +905,16 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_var (id, name);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_unpack name ->
       let id = enter_variable loc name expected_ty ~is_module:true in
       rp {
         pat_desc = Tpat_var (id, name);
         pat_loc = sp.ppat_loc;
-        pat_extra=[Tpat_unpack, loc];
+        pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
         pat_type = expected_ty;
+        pat_attributes = [];
         pat_env = !env }
   | Ppat_constraint({ppat_desc=Ppat_var name; ppat_loc=lloc},
                     ({ptyp_desc=Ptyp_poly _} as sty)) ->
@@ -905,8 +933,9 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
           rp {
             pat_desc = Tpat_var (id, name);
             pat_loc = lloc;
-            pat_extra = [Tpat_constraint cty, loc];
+            pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
             pat_type = ty;
+            pat_attributes = [];
             pat_env = !env
           }
       | _ -> assert false
@@ -922,6 +951,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_alias(q, id, name);
         pat_loc = loc; pat_extra=[];
         pat_type = q.pat_type;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_constant cst ->
       unify_pat_types loc !env (type_constant cst) expected_ty;
@@ -929,7 +959,21 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_constant cst;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
+  | Ppat_interval (Const_char c1, Const_char c2) ->
+      let open Ast_helper.Pat in
+      let rec loop c1 c2 =
+        if c1 = c2 then constant ~loc (Const_char c1)
+        else
+          or_ ~loc
+            (constant ~loc (Const_char c1))
+            (loop (Char.chr(Char.code c1 + 1)) c2)
+      in
+      let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
+      type_pat p expected_ty (* TODO: record 'extra' to remember about interval *)
+  | Ppat_interval _ ->
+      raise (Error (loc, !env, Invalid_interval))
   | Ppat_tuple spl ->
       let spl_ann = List.map (fun p -> (p,newvar ())) spl in
       let ty = newty (Ttuple(List.map snd spl_ann)) in
@@ -939,10 +983,11 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_tuple pl;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
-  | Ppat_construct(lid, sarg, explicit_arity) ->
+  | Ppat_construct(lid, sarg) ->
       let opath =
-        try 
+        try
           let (p0, p, _) = extract_concrete_variant !env expected_ty in
             Some (p0, p, true)
 	with Not_found -> None
@@ -970,7 +1015,6 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
       let sargs =
         match sarg with
           None -> []
-        | Some {ppat_desc = Ppat_tuple spl} when explicit_arity -> spl
         | Some {ppat_desc = Ppat_tuple spl} when constr.cstr_arity > 1 -> spl
         | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 ->
             if constr.cstr_arity = 0 then
@@ -990,9 +1034,10 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         unify_pat_types loc !env ty_res expected_ty;
       let args = List.map2 (fun p t -> type_pat p t) sargs ty_args in
       rp {
-        pat_desc=Tpat_construct(lid, constr, args,explicit_arity);
+        pat_desc=Tpat_construct(lid, constr, args);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_variant(l, sarg) ->
       let arg = may_map (fun p -> type_pat p (newvar())) sarg in
@@ -1009,6 +1054,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()});
         pat_loc = loc; pat_extra=[];
         pat_type =  expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_record(lid_sp_list, closed) ->
       let opath, record_ty =
@@ -1049,6 +1095,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_record (lbl_pat_list, closed);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_array spl ->
       let ty_elt = newvar() in
@@ -1060,6 +1107,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_array pl;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_or(sp1, sp2) ->
       let initial_pattern_variables = !pattern_variables in
@@ -1075,6 +1123,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_lazy sp1 ->
       let nv = newvar () in
@@ -1085,6 +1134,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_lazy p1;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_constraint(sp, sty) ->
       (* Separate when not already separated by !principal *)
@@ -1105,20 +1155,23 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         Printtyp.raw_type_expr ty
         Printtyp.raw_type_expr p.pat_type;*)
       pattern_force := force :: !pattern_force;
+      let extra = (Tpat_constraint cty, loc, sp.ppat_attributes) in
       if separate then
         match p.pat_desc with
           Tpat_var (id,s) ->
             {p with pat_type = ty;
-             pat_desc = Tpat_alias ({p with pat_desc = Tpat_any}, id,s);
-             pat_extra = [Tpat_constraint cty, loc];
+             pat_desc = Tpat_alias ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s);
+             pat_extra = [extra];
             }
         | _ -> {p with pat_type = ty;
-                pat_extra = (Tpat_constraint cty,loc) :: p.pat_extra}
+                pat_extra = extra :: p.pat_extra}
       else p
   | Ppat_type lid ->
       let (path, p,ty) = build_or_pat !env loc lid.txt in
       unify_pat_types loc !env ty expected_ty;
-      { p with pat_extra = (Tpat_type (path, lid), loc) :: p.pat_extra }
+      { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra }
+  | Ppat_extension (s, _arg) ->
+      raise (Error (s.loc, !env, Extension s.txt))
 
 let type_pat ?(allow_existentials=false) ?constrs ?labels
     ?(lev=get_current_level()) env sp expected_ty =
@@ -1218,12 +1271,11 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
   let val_env, _ = add_pattern_variables val_env in
   (pat, pv, val_env, met_env)
 
-let mkpat d = { ppat_desc = d; ppat_loc = Location.none }
-
 let type_self_pattern cl_num privty val_env met_env par_env spat =
+  let open Ast_helper in
   let spat =
-    mkpat (Ppat_alias (mkpat(Ppat_alias (spat, mknoloc "selfpat-*")),
-                       mknoloc ("selfpat-" ^ cl_num)))
+    Pat.mk (Ppat_alias (Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")),
+                        mknoloc ("selfpat-" ^ cl_num)))
   in
   reset_pattern None false;
   let nv = newvar() in
@@ -1270,7 +1322,7 @@ let rec final_subexpression sexp =
   | Pexp_sequence (_, e)
   | Pexp_try (e, _)
   | Pexp_ifthenelse (_, e, _)
-  | Pexp_match (_, (_, e) :: _)
+  | Pexp_match (_, {pc_rhs=e} :: _)
     -> final_subexpression e
   | _ -> sexp
 
@@ -1281,17 +1333,20 @@ let rec is_nonexpansive exp =
     Texp_ident(_,_,_) -> true
   | Texp_constant _ -> true
   | Texp_let(rec_flag, pat_exp_list, body) ->
-      List.for_all (fun (pat, exp) -> is_nonexpansive exp) pat_exp_list &&
+      List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list &&
       is_nonexpansive body
   | Texp_function _ -> true
   | Texp_apply(e, (_,None,_)::el) ->
       is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd3 el)
-  | Texp_match(e, pat_exp_list, _) ->
+  | Texp_match(e, cases, _) ->
       is_nonexpansive e &&
-      List.for_all (fun (pat, exp) -> is_nonexpansive exp) pat_exp_list
+      List.for_all
+        (fun {c_lhs = _; c_guard; c_rhs} ->
+           is_nonexpansive_opt c_guard && is_nonexpansive c_rhs
+        ) cases
   | Texp_tuple el ->
       List.for_all is_nonexpansive el
-  | Texp_construct( _, _, el,_) ->
+  | Texp_construct( _, _, el) ->
       List.for_all is_nonexpansive el
   | Texp_variant(_, arg) -> is_nonexpansive_opt arg
   | Texp_record(lbl_exp_list, opt_init_exp) ->
@@ -1312,14 +1367,14 @@ let rec is_nonexpansive exp =
       let count = ref 0 in
       List.for_all
         (fun field -> match field.cf_desc with
-            Tcf_meth _ -> true
-          | Tcf_val (_,_, _, _, Tcfk_concrete e,_) ->
+            Tcf_method _ -> true
+          | Tcf_val (_, _, _, Tcfk_concrete (_, e), _) ->
               incr count; is_nonexpansive e
-          | Tcf_val (_,_, _, _, Tcfk_virtual _,_) ->
+          | Tcf_val (_, _, _, Tcfk_virtual _, _) ->
               incr count; true
-          | Tcf_init e -> is_nonexpansive e
-          | Tcf_constr _ -> true
-          | Tcf_inher _ -> false)
+          | Tcf_initializer e -> is_nonexpansive e
+          | Tcf_constraint _ -> true
+          | Tcf_inherit _ -> false)
         fields &&
       Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
         vars true &&
@@ -1342,13 +1397,14 @@ and is_nonexpansive_mod mexp =
           | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
           | Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true
           | Tstr_value (_, pat_exp_list) ->
-              List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
-          | Tstr_module (_, _, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
+              List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
+          | Tstr_module {mb_expr=m;_} | Tstr_include (m, _, _) -> is_nonexpansive_mod m
           | Tstr_recmodule id_mod_list ->
-              List.for_all (fun (_, _, _, m) -> is_nonexpansive_mod m)
+              List.for_all (fun {mb_expr=m;_} -> is_nonexpansive_mod m)
                 id_mod_list
           | Tstr_exception _ -> false (* true would be unsound *)
           | Tstr_class _ -> false (* could be more precise *)
+          | Tstr_attribute _ -> true
         )
         str.str_items
   | Tmod_apply _ -> false
@@ -1586,27 +1642,36 @@ let rec approx_type env sty =
 let rec type_approx env sexp =
   match sexp.pexp_desc with
     Pexp_let (_, _, e) -> type_approx env e
-  | Pexp_function (p,_,(_,e)::_) when is_optional p ->
+  | Pexp_fun (p, _, _, e) when is_optional p ->
        newty (Tarrow(p, type_option (newvar ()), type_approx env e, Cok))
-  | Pexp_function (p,_,(_,e)::_) ->
+  | Pexp_fun (p,_,_, e) ->
        newty (Tarrow(p, newvar (), type_approx env e, Cok))
-  | Pexp_match (_, (_,e)::_) -> type_approx env e
+  | Pexp_function ({pc_rhs=e}::_) ->
+       newty (Tarrow("", newvar (), type_approx env e, Cok))
+  | Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e
   | Pexp_try (e, _) -> type_approx env e
   | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
   | Pexp_ifthenelse (_,e,_) -> type_approx env e
   | Pexp_sequence (_,e) -> type_approx env e
-  | Pexp_constraint (e, sty1, sty2) ->
+  | Pexp_constraint (e, sty) ->
+      let ty = type_approx env e in
+      let ty1 = approx_type env sty in
+      begin try unify env ty ty1 with Unify trace ->
+        raise(Error(sexp.pexp_loc, env, Expr_type_clash trace))
+      end;
+      ty1
+  | Pexp_coerce (e, sty1, sty2) ->
       let approx_ty_opt = function
         | None -> newvar ()
         | Some sty -> approx_type env sty
       in
       let ty = type_approx env e
       and ty1 = approx_ty_opt sty1
-      and ty2 = approx_ty_opt sty2 in
+      and ty2 = approx_type env sty2 in
       begin try unify env ty ty1 with Unify trace ->
         raise(Error(sexp.pexp_loc, env, Expr_type_clash trace))
       end;
-      if sty2 = None then ty1 else ty2
+      ty2
   | _ -> newvar ()
 
 (* List labels in a function type, and whether return type is a variable *)
@@ -1683,14 +1748,15 @@ let create_package_type loc env (p, l) =
    (s, fields, ty)
 
  let wrap_unpacks sexp unpacks =
+   let open Ast_helper in
    List.fold_left
      (fun sexp (name, loc) ->
-       {pexp_loc = sexp.pexp_loc; pexp_desc = Pexp_letmodule (
-        name,
-        {pmod_loc = loc; pmod_desc = Pmod_unpack
-           {pexp_desc=Pexp_ident(mkloc (Longident.Lident name.txt) name.loc);
-            pexp_loc=name.loc}},
-       sexp)})
+       Exp.letmodule ~loc:sexp.pexp_loc
+         name
+         (Mod.unpack ~loc
+            (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt) name.loc)))
+         sexp
+     )
     sexp unpacks
 
 (* Helpers for type_cases *)
@@ -1718,11 +1784,12 @@ let contains_variant_either ty =
 
 let iter_ppat f p =
   match p.ppat_desc with
-  | Ppat_any | Ppat_var _ | Ppat_constant _
+  | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _
+  | Ppat_extension _
   | Ppat_type _ | Ppat_unpack _ -> ()
   | Ppat_array pats -> List.iter f pats
   | Ppat_or (p1,p2) -> f p1; f p2
-  | Ppat_variant (_, arg) | Ppat_construct (_, arg, _) -> may f arg
+  | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg
   | Ppat_tuple lst ->  List.iter f lst
   | Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p
   | Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args
@@ -1738,7 +1805,7 @@ let contains_polymorphic_variant p =
 let contains_gadt env p =
   let rec loop p =
     match p.ppat_desc with
-      Ppat_construct (lid, _, _) ->
+      Ppat_construct (lid, _) ->
         begin try
           let cstrs = Env.lookup_all_constructors lid.txt env in
           List.iter (fun (cstr,_) -> if cstr.cstr_generalized then raise Exit)
@@ -1768,15 +1835,13 @@ let check_absent_variant env =
       | _ -> ())
       
 
-let dummy_expr = {pexp_desc = Pexp_tuple []; pexp_loc = Location.none}
-
 (* Duplicate types of values in the environment *)
 (* XXX Should we do something about global type variables too? *)
 
 let duplicate_ident_types loc caselist env =
   let caselist =
-    List.filter (fun (pat, _) -> contains_gadt env pat) caselist in
-  let idents = all_idents (List.map snd caselist) in
+    List.filter (fun {pc_lhs} -> contains_gadt env pc_lhs) caselist in
+  let idents = all_idents_cases caselist in
   List.fold_left
     (fun env s ->
       try
@@ -1857,9 +1922,10 @@ and type_expect_ ?in_function env sexp ty_expected =
           end;
           exp_loc = loc; exp_extra = [];
           exp_type = instance env desc.val_type;
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       end
-  | Pexp_constant(Const_string s as cst) ->
+  | Pexp_constant(Const_string (s, _) as cst) ->
       rue {
         exp_desc = Texp_constant cst;
         exp_loc = loc; exp_extra = [];
@@ -1870,23 +1936,26 @@ and type_expect_ ?in_function env sexp ty_expected =
                type_format loc s
            | _ -> instance_def Predef.type_string
            end;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_constant cst ->
       rue {
         exp_desc = Texp_constant cst;
         exp_loc = loc; exp_extra = [];
         exp_type = type_constant cst;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
-  | Pexp_let(Nonrecursive, [spat, sval], sbody) when contains_gadt env spat ->
+  | Pexp_let(Nonrecursive, [{pvb_pat=spat; pvb_expr=sval; pvb_attributes=[]}], sbody) when contains_gadt env spat ->
+    (* TODO: allow non-empty attributes? *)
       type_expect ?in_function env
-        {sexp with pexp_desc = Pexp_match (sval, [spat, sbody])}
+        {sexp with pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])}
         ty_expected
   | Pexp_let(rec_flag, spat_sexp_list, sbody) ->
       let scp =
-        match rec_flag with
-        | Recursive -> Some (Annot.Idef loc)
-        | Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
-        | Default -> None
+        match sexp.pexp_attributes, rec_flag with
+        | [{txt="#default"},_], _ -> None
+        | _, Recursive -> Some (Annot.Idef loc)
+        | _, Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
       in
       let (pat_exp_list, new_env, unpacks) =
         type_let env rec_flag spat_sexp_list scp true in
@@ -1896,96 +1965,44 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_let(rec_flag, pat_exp_list, body);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
-  | Pexp_function (l, Some default, [spat, sbody]) ->
+  | Pexp_fun (l, Some default, spat, sexp) ->
+      assert(is_optional l); (* default allowed only with optional argument *)
+      let open Ast_helper in
       let default_loc = default.pexp_loc in
       let scases = [
-         {ppat_loc = default_loc;
-          ppat_desc =
-            Ppat_construct
-              (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))),
-               Some {ppat_loc = default_loc;
-                     ppat_desc = Ppat_var (mknoloc "*sth*")},
-               false)},
-         {pexp_loc = default_loc;
-          pexp_desc = Pexp_ident(mknoloc (Longident.Lident "*sth*"))};
-         {ppat_loc = default_loc;
-          ppat_desc = Ppat_construct
-             (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))),
-              None, false)},
-         default;
-      ] in
-      let smatch = {
-        pexp_loc = loc;
-        pexp_desc =
-          Pexp_match ({
-            pexp_loc = loc;
-            pexp_desc = Pexp_ident(mknoloc (Longident.Lident "*opt*"))
-            },
-            scases
-          )
-      } in
-      let sfun = {
-        pexp_loc = loc;
-        pexp_desc =
-         Pexp_function (
-           l, None,
-           [ {ppat_loc = loc;
-              ppat_desc = Ppat_var (mknoloc "*opt*")},
-             {pexp_loc = loc;
-              pexp_desc = Pexp_let(Default, [spat, smatch], sbody);
-             }
-           ]
-         )
-      } in
-      type_expect ?in_function env sfun ty_expected
-  | Pexp_function (l, _, caselist) ->
-      let (loc_fun, ty_fun) =
-        match in_function with Some p -> p
-        | None -> (loc, instance env ty_expected)
+        Exp.case
+          (Pat.construct ~loc:default_loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
+             (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
+          (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*")));
+
+        Exp.case
+          (Pat.construct ~loc:default_loc
+             (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
+             None)
+          default;
+       ]
       in
-      let separate = !Clflags.principal || Env.has_local_constraints env in
-      if separate then begin_def ();
-      let (ty_arg, ty_res) =
-        try filter_arrow env (instance env ty_expected) l
-        with Unify _ ->
-          match expand_head env ty_expected with
-            {desc = Tarrow _} as ty ->
-              raise(Error(loc, env, Abstract_wrong_label(l, ty)))
-          | _ ->
-              raise(Error(loc_fun, env,
-                          Too_many_arguments (in_function <> None, ty_fun)))
+      let smatch =
+        Exp.match_ ~loc (Exp.ident ~loc (mknoloc (Longident.Lident "*opt*")))
+          scases
       in
-      let ty_arg =
-        if is_optional l then
-          let tv = newvar() in
-          begin
-            try unify env ty_arg (type_option tv)
-            with Unify _ -> assert false
-          end;
-          type_option tv
-        else ty_arg
-      in
-      if separate then begin
-        end_def ();
-        generalize_structure ty_arg;
-        generalize_structure ty_res
-      end;
-      let cases, partial =
-        type_cases ~in_function:(loc_fun,ty_fun) env ty_arg ty_res
-          true loc caselist in
-      let not_function ty =
-        let ls, tvar = list_labels env ty in
-        ls = [] && not tvar
+      let sfun =
+        Exp.fun_ ~loc
+          l None
+          (Pat.var ~loc (mknoloc "*opt*"))
+          (Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",PStr []] [Vb.mk spat smatch] sexp)
       in
-      if is_optional l && not_function ty_res then
-        Location.prerr_warning (fst (List.hd cases)).pat_loc
-          Warnings.Unerasable_optional_argument;
-      re {
-        exp_desc = Texp_function(l,cases, partial);
-        exp_loc = loc; exp_extra = [];
-        exp_type = instance env (newgenty (Tarrow(l, ty_arg, ty_res, Cok)));
-        exp_env = env }
+      type_expect ?in_function env sfun ty_expected
+        (* TODO: keep attributes, call type_function directly *)
+  | Pexp_fun (l, None, spat, sexp) ->
+      type_function ?in_function loc sexp.pexp_attributes env ty_expected
+        l [{pc_lhs=spat; pc_guard=None; pc_rhs=sexp}]
+  | Pexp_function caselist ->
+      type_function ?in_function
+        loc sexp.pexp_attributes env ty_expected "" caselist
   | Pexp_apply(sfunct, sargs) ->
       begin_def (); (* one more level for non-returning functions *)
       if !Clflags.principal then begin_def ();
@@ -2014,6 +2031,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_apply(funct, args);
         exp_loc = loc; exp_extra = [];
         exp_type = ty_res;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_match(sarg, caselist) ->
       begin_def ();
@@ -2028,6 +2046,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_match(arg, cases, partial);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_try(sbody, caselist) ->
       let body = type_expect env sbody ty_expected in
@@ -2037,6 +2056,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_try(body, cases);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_tuple sexpl ->
       let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
@@ -2050,9 +2070,10 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_loc = loc; exp_extra = [];
         (* Keep sharing *)
         exp_type = newty (Ttuple (List.map (fun e -> e.exp_type) expl));
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
-  | Pexp_construct(lid, sarg, explicit_arity) ->
-      type_construct env loc lid sarg explicit_arity ty_expected
+  | Pexp_construct(lid, sarg) ->
+      type_construct env loc lid sarg ty_expected sexp.pexp_attributes
   | Pexp_variant(l, sarg) ->
       (* Keep sharing *)
       let ty_expected0 = instance env ty_expected in
@@ -2067,6 +2088,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               re { exp_desc = Texp_variant(l, Some arg);
                    exp_loc = loc; exp_extra = [];
                    exp_type = ty_expected0;
+                   exp_attributes = sexp.pexp_attributes;
                    exp_env = env }
           | _ -> raise Not_found
           end
@@ -2083,6 +2105,7 @@ and type_expect_ ?in_function env sexp ty_expected =
                                     row_closed = false;
                                     row_fixed = false;
                                     row_name = None});
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       end
   | Pexp_record(lid_sexp_list, opt_sexp) ->
@@ -2177,6 +2200,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_record(lbl_exp_list, opt_exp);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_field(srecord, lid) ->
       let (record, label, _) = type_label_access env loc srecord lid in
@@ -2186,6 +2210,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_field(record, lid, label);
         exp_loc = loc; exp_extra = [];
         exp_type = ty_arg;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_setfield(srecord, lid, snewval) ->
       let (record, label, opath) = type_label_access env loc srecord lid in
@@ -2199,6 +2224,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_setfield(record, label_loc, label, newval);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_array(sargl) ->
       let ty = newgenvar() in
@@ -2209,6 +2235,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_array argl;
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_ifthenelse(scond, sifso, sifnot) ->
       let cond = type_expect env scond Predef.type_bool in
@@ -2219,6 +2246,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_ifthenelse(cond, ifso, None);
             exp_loc = loc; exp_extra = [];
             exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       | Some sifnot ->
           let ifso = type_expect env sifso ty_expected in
@@ -2229,6 +2257,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
             exp_loc = loc; exp_extra = [];
             exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       end
   | Pexp_sequence(sexp1, sexp2) ->
@@ -2238,6 +2267,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_sequence(exp1, exp2);
         exp_loc = loc; exp_extra = [];
         exp_type = exp2.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_while(scond, sbody) ->
       let cond = type_expect env scond Predef.type_bool in
@@ -2246,6 +2276,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_while(cond, body);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_for(param, slow, shigh, dir, sbody) ->
       let low = type_expect env slow Predef.type_int in
@@ -2260,27 +2291,35 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_for(id, param, low, high, dir, body);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
-  | Pexp_constraint(sarg, sty, sty') ->
+  | Pexp_constraint (sarg, sty) ->
+      let separate = true in (* always separate, 1% slowdown for lablgtk *)
+      if separate then begin_def ();
+      let cty = Typetexp.transl_simple_type env false sty in
+      let ty = cty.ctyp_type in
+      let (arg, ty') =
+        if separate then begin
+          end_def ();
+          generalize_structure ty;
+          (type_argument env sarg ty (instance env ty), instance env ty)
+        end else
+          (type_argument env sarg ty ty, ty)
+      in
+      rue {
+        exp_desc = arg.exp_desc;
+        exp_loc = arg.exp_loc;
+        exp_type = ty';
+        exp_attributes = arg.exp_attributes;
+        exp_env = env;
+        exp_extra = (Texp_constraint cty, loc, sexp.pexp_attributes) :: arg.exp_extra;
+      }
+  | Pexp_coerce(sarg, sty, sty') ->
       let separate = true (* always separate, 1% slowdown for lablgtk *)
         (* !Clflags.principal || Env.has_local_constraints env *) in
       let (arg, ty',cty,cty') =
-        match (sty, sty') with
-          (None, None) ->               (* Case actually unused *)
-            let arg = type_exp env sarg in
-            (arg, arg.exp_type,None,None)
-        | (Some sty, None) ->
-            if separate then begin_def ();
-            let cty = Typetexp.transl_simple_type env false sty in
-            let ty = cty.ctyp_type in
-            if separate then begin
-              end_def ();
-              generalize_structure ty;
-              (type_argument env sarg ty (instance env ty),
-               instance env ty, Some cty, None)
-            end else
-              (type_argument env sarg ty ty, ty, Some cty, None)
-        | (None, Some sty') ->
+        match sty with
+        | None ->
             let (cty', force) =
               Typetexp.transl_simple_type_delayed env sty'
             in
@@ -2330,8 +2369,8 @@ and type_expect_ ?in_function env sexp ty_expected =
                         Coercion_failure(ty', full_expand env ty', trace, b)))
                 end
             end;
-            (arg, ty', None, Some cty')
-        | (Some sty, Some sty') ->
+            (arg, ty', None, cty')
+        | Some sty ->
             if separate then begin_def ();
             let (cty, force) =
               Typetexp.transl_simple_type_delayed env sty
@@ -2351,25 +2390,19 @@ and type_expect_ ?in_function env sexp ty_expected =
               generalize_structure ty;
               generalize_structure ty';
               (type_argument env sarg ty (instance env ty),
-               instance env ty', Some cty, Some cty')
+               instance env ty', Some cty, cty')
             end else
-              (type_argument env sarg ty ty, ty', Some cty, Some cty')
+              (type_argument env sarg ty ty, ty', Some cty, cty')
       in
       rue {
         exp_desc = arg.exp_desc;
         exp_loc = arg.exp_loc;
         exp_type = ty';
+        exp_attributes = arg.exp_attributes;
         exp_env = env;
-        exp_extra = (Texp_constraint (cty, cty'), loc) :: arg.exp_extra;
+        exp_extra = (Texp_coerce (cty, cty'), loc, sexp.pexp_attributes) ::
+                       arg.exp_extra;
       }
-  | Pexp_when(scond, sbody) ->
-      let cond = type_expect env scond Predef.type_bool in
-      let body = type_expect env sbody ty_expected in
-      re {
-        exp_desc = Texp_when(cond, body);
-        exp_loc = loc; exp_extra = [];
-        exp_type = body.exp_type;
-        exp_env = env }
   | Pexp_send (e, met) ->
       if !Clflags.principal then begin_def ();
       let obj = type_exp env e in
@@ -2411,17 +2444,20 @@ and type_expect_ ?in_function env sexp ty_expected =
                                             Types.val_loc = Location.none});
                                 exp_loc = loc; exp_extra = [];
                                 exp_type = method_type;
+                                exp_attributes = []; (* check *)
                                 exp_env = env},
                           ["",
                             Some {exp_desc = Texp_ident(path, lid, desc);
                                   exp_loc = obj.exp_loc; exp_extra = [];
                                   exp_type = desc.val_type;
+                                  exp_attributes = []; (* check *)
                                   exp_env = env},
                                Required])
                   in
                   (Tmeth_name met, Some (re {exp_desc = exp;
                                              exp_loc = loc; exp_extra = [];
                                              exp_type = typ;
+                                             exp_attributes = []; (* check *)
                                              exp_env = env}), typ)
               |  _ ->
                   assert false
@@ -2456,6 +2492,7 @@ and type_expect_ ?in_function env sexp ty_expected =
           exp_desc = Texp_send(obj, meth, exp);
           exp_loc = loc; exp_extra = [];
           exp_type = typ;
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       with Unify _ ->
         raise(Error(e.pexp_loc, env, Undefined_method (obj.exp_type, met)))
@@ -2470,6 +2507,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               exp_desc = Texp_new (cl_path, cl, cl_decl);
               exp_loc = loc; exp_extra = [];
               exp_type = instance_def ty;
+              exp_attributes = sexp.pexp_attributes;
               exp_env = env }
         end
   | Pexp_setinstvar (lab, snewval) ->
@@ -2486,6 +2524,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               exp_desc = Texp_setinstvar(path_self, path, lab, newval);
               exp_loc = loc; exp_extra = [];
               exp_type = instance_def Predef.type_unit;
+              exp_attributes = sexp.pexp_attributes;
               exp_env = env }
         | Val_ivar _ ->
             raise(Error(loc, env, Instance_variable_not_mutable(true,lab.txt)))
@@ -2528,6 +2567,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_override(path_self, modifs);
             exp_loc = loc; exp_extra = [];
             exp_type = self_ty;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       | _ ->
           assert false
@@ -2559,20 +2599,22 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_letmodule(id, name, modl, body);
         exp_loc = loc; exp_extra = [];
         exp_type = ty;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_assert (e) ->
       let cond = type_expect env e Predef.type_bool in
+      let exp_type =
+        match cond.exp_desc with
+        | Texp_construct(_, {cstr_name="false"}, _) ->
+            instance env ty_expected
+        | _ ->
+            instance_def Predef.type_unit
+      in
       rue {
-        exp_desc = Texp_assert (cond);
+        exp_desc = Texp_assert cond;
         exp_loc = loc; exp_extra = [];
-        exp_type = instance_def Predef.type_unit;
-        exp_env = env;
-      }
-  | Pexp_assertfalse ->
-      re {
-        exp_desc = Texp_assertfalse;
-        exp_loc = loc; exp_extra = [];
-        exp_type = instance env ty_expected;
+        exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_lazy e ->
@@ -2584,6 +2626,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_lazy arg;
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_object s ->
@@ -2592,6 +2635,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_object (desc, (*sign,*) meths);
         exp_loc = loc; exp_extra = [];
         exp_type = sign.cty_self;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_poly(sbody, sty) ->
@@ -2599,6 +2643,7 @@ and type_expect_ ?in_function env sexp ty_expected =
       let ty, cty =
         match sty with None -> repr ty_expected, None
         | Some sty ->
+            let sty = Ast_helper.Typ.force_poly sty in
             let cty = Typetexp.transl_simple_type env false sty in
             repr cty.ctyp_type, Some cty
       in
@@ -2633,7 +2678,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp
         | _ -> assert false
       in
-      re { exp with exp_extra = (Texp_poly cty, loc) :: exp.exp_extra }
+      re { exp with exp_extra = (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
   | Pexp_newtype(name, sbody) ->
       let ty = newvar () in
       (* remember original level *)
@@ -2678,7 +2723,7 @@ and type_expect_ ?in_function env sexp ty_expected =
       (* non-expansive if the body is non-expansive, so we don't introduce
          any new extra node in the typed AST. *)
       rue { body with exp_loc = loc; exp_type = ety;
-            exp_extra = (Texp_newtype name, loc) :: body.exp_extra }
+            exp_extra = (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra }
   | Pexp_pack m ->
       let (p, nl, tl) =
         match Ctype.expand_head env (instance env ty_expected) with
@@ -2699,14 +2744,68 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_pack modl;
         exp_loc = loc; exp_extra = [];
         exp_type = newty (Tpackage (p, nl, tl'));
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_open (ovf, lid, e) ->
       let (path, newenv) = !type_open ovf env sexp.pexp_loc lid in
       let exp = type_expect newenv e ty_expected in
       { exp with
-        exp_extra = (Texp_open (ovf, path, lid, newenv), loc) ::
+        exp_extra = (Texp_open (ovf, path, lid, newenv), loc,
+                     sexp.pexp_attributes) ::
                       exp.exp_extra;
       }
+  | Pexp_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
+
+and type_function ?in_function loc attrs env ty_expected l caselist =
+  let (loc_fun, ty_fun) =
+    match in_function with Some p -> p
+    | None -> (loc, instance env ty_expected)
+  in
+  let separate = !Clflags.principal || Env.has_local_constraints env in
+  if separate then begin_def ();
+  let (ty_arg, ty_res) =
+    try filter_arrow env (instance env ty_expected) l
+    with Unify _ ->
+      match expand_head env ty_expected with
+        {desc = Tarrow _} as ty ->
+          raise(Error(loc, env, Abstract_wrong_label(l, ty)))
+      | _ ->
+          raise(Error(loc_fun, env,
+                      Too_many_arguments (in_function <> None, ty_fun)))
+  in
+  let ty_arg =
+    if is_optional l then
+      let tv = newvar() in
+      begin
+        try unify env ty_arg (type_option tv)
+        with Unify _ -> assert false
+      end;
+      type_option tv
+    else ty_arg
+  in
+  if separate then begin
+    end_def ();
+    generalize_structure ty_arg;
+    generalize_structure ty_res
+  end;
+  let cases, partial =
+    type_cases ~in_function:(loc_fun,ty_fun) env ty_arg ty_res
+      true loc caselist in
+  let not_function ty =
+    let ls, tvar = list_labels env ty in
+    ls = [] && not tvar
+  in
+  if is_optional l && not_function ty_res then
+    Location.prerr_warning (List.hd cases).c_lhs.pat_loc
+      Warnings.Unerasable_optional_argument;
+  re {
+  exp_desc = Texp_function(l,cases, partial);
+    exp_loc = loc; exp_extra = [];
+    exp_type = instance env (newgenty (Tarrow(l, ty_arg, ty_res, Cok)));
+    exp_attributes = attrs;
+    exp_env = env }
+
 
 and type_label_access env loc srecord lid =
   if !Clflags.principal then begin_def ();
@@ -2825,9 +2924,10 @@ and type_argument env sarg ty_expected' ty_expected =
       let var_pair name ty =
         let id = Ident.create name in
         {pat_desc = Tpat_var (id, mknoloc name); pat_type = ty;pat_extra=[];
+         pat_attributes = [];
          pat_loc = Location.none; pat_env = env},
         {exp_type = ty; exp_loc = Location.none; exp_env = env;
-         exp_extra = [];
+         exp_extra = []; exp_attributes = [];
          exp_desc =
          Texp_ident(Path.Pident id, mknoloc (Longident.Lident name),
                     {val_type = ty; val_kind = Val_reg;
@@ -2835,18 +2935,22 @@ and type_argument env sarg ty_expected' ty_expected =
       in
       let eta_pat, eta_var = var_pair "eta" ty_arg in
       let func texp =
+        let e =
+          {texp with exp_type = ty_res; exp_desc =
+           Texp_apply
+             (texp,
+              List.rev args @ ["", Some eta_var, Required])}
+        in
         { texp with exp_type = ty_fun; exp_desc =
-          Texp_function("", [eta_pat, {texp with exp_type = ty_res; exp_desc =
-                    Texp_apply (texp,
-                                List.rev args @ ["", Some eta_var, Required])}],
-                        Total) } in
+          Texp_function("", [case eta_pat e], Total) }
+      in
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Without_principality "eliminated optional argument");
       if is_nonexpansive texp then func texp else
       (* let-expand to have side effects *)
       let let_pat, let_var = var_pair "arg" texp.exp_type in
       re { texp with exp_type = ty_fun; exp_desc =
-           Texp_let (Nonrecursive, [let_pat, texp], func let_var) }
+           Texp_let (Nonrecursive, [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[]}], func let_var) }
       end
   | _ ->
       let texp = type_expect env sarg ty_expected' in
@@ -3042,7 +3146,7 @@ and type_application env funct sargs =
       else
         type_args [] [] ty (instance env ty) ty sargs []
 
-and type_construct env loc lid sarg explicit_arity ty_expected =
+and type_construct env loc lid sarg ty_expected attrs =
   let opath =
     try
       let (p0, p,_) = extract_concrete_variant env ty_expected in
@@ -3055,7 +3159,6 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
   let sargs =
     match sarg with
       None -> []
-    | Some {pexp_desc = Pexp_tuple sel} when explicit_arity -> sel
     | Some {pexp_desc = Pexp_tuple sel} when constr.cstr_arity > 1 -> sel
     | Some se -> [se] in
   if List.length sargs <> constr.cstr_arity then
@@ -3066,9 +3169,10 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
   let (ty_args, ty_res) = instance_constructor constr in
   let texp =
     re {
-      exp_desc = Texp_construct(lid, constr, [],explicit_arity);
+      exp_desc = Texp_construct(lid, constr, []);
       exp_loc = loc; exp_extra = [];
       exp_type = ty_res;
+      exp_attributes = attrs;
       exp_env = env } in
   if separate then begin
     end_def ();
@@ -3090,8 +3194,9 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
       (List.combine ty_args ty_args0) in
   if constr.cstr_private = Private then
     raise(Error(loc, env, Private_type ty_res));
+  (* NOTE: shouldn't we call "re" on this final expression? -- AF *)
   { texp with
-    exp_desc = Texp_construct(lid, constr, args, explicit_arity) }
+    exp_desc = Texp_construct(lid, constr, args) }
 
 (* Typing of statements (expressions whose values are discarded) *)
 
@@ -3121,9 +3226,9 @@ and type_statement env sexp =
 
 (* Typing of match cases *)
 
-and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
+and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist : Typedtree.case list * _ =
   (* ty_arg is _fully_ generalized *)
-  let patterns = List.map fst caselist in
+  let patterns = List.map (fun {pc_lhs=p} -> p) caselist in
   let erase_either =
     List.exists contains_polymorphic_variant patterns
     && contains_variant_either ty_arg
@@ -3156,8 +3261,13 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
     Printtyp.raw_type_expr ty_arg; *)
   let pat_env_list =
     List.map
-      (fun (spat, sexp) ->
-        let loc = sexp.pexp_loc in
+      (fun {pc_lhs; pc_guard; pc_rhs} ->
+        let loc =
+          let open Location in
+          match pc_guard with
+          | None -> pc_rhs.pexp_loc
+          | Some g -> {pc_rhs.pexp_loc with loc_start=g.pexp_loc.loc_start}
+        in
         if !Clflags.principal then begin_def (); (* propagation of pattern *)
         let scope = Some (Annot.Idef loc) in
         let (pat, ext_env, force, unpacks) =
@@ -3165,7 +3275,7 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
             if !Clflags.principal || erase_either
             then Some false else None in
           let ty_arg = instance ?partial env ty_arg in
-          type_pattern ~lev env spat scope ty_arg
+          type_pattern ~lev env pc_lhs scope ty_arg
         in
         pattern_force := force @ !pattern_force;
         let pat =
@@ -3197,8 +3307,8 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
   let in_function = if List.length caselist = 1 then in_function else None in
   let cases =
     List.map2
-      (fun (pat, (ext_env, unpacks)) (spat, sexp) ->
-        let sexp = wrap_unpacks sexp unpacks in
+      (fun (pat, (ext_env, unpacks)) {pc_lhs; pc_guard; pc_rhs} ->
+        let sexp = wrap_unpacks pc_rhs unpacks in
         let ty_res' =
           if !Clflags.principal then begin
             begin_def ();
@@ -3206,17 +3316,30 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
             end_def ();
             generalize_structure ty; ty
           end
-          else if contains_gadt env spat then correct_levels ty_res
+          else if contains_gadt env pc_lhs then correct_levels ty_res
           else ty_res in
 (*        Format.printf "@[%i %i, ty_res' =@ %a@]@." lev (get_current_level())
           Printtyp.raw_type_expr ty_res'; *)
+        let guard =
+          match pc_guard with
+          | None -> None
+          | Some scond ->
+              Some
+                (type_expect ext_env (wrap_unpacks scond unpacks)
+                   Predef.type_bool)
+        in
         let exp = type_expect ?in_function ext_env sexp ty_res' in
-        (pat, {exp with exp_type = instance env ty_res'}))
+        {
+         c_lhs = pat;
+         c_guard = guard;
+         c_rhs = {exp with exp_type = instance env ty_res'}
+        }
+      )
       pat_env_list caselist
   in
   if !Clflags.principal || has_gadts then begin
     let ty_res' = instance env ty_res in
-    List.iter (fun (_,exp) -> unify_exp env exp ty_res') cases
+    List.iter (fun c -> unify_exp env c.c_rhs ty_res') cases
   end;
   let partial =
     if partial_flag then
@@ -3241,13 +3364,14 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
 and type_let ?(check = fun s -> Warnings.Unused_var s)
              ?(check_strict = fun s -> Warnings.Unused_var_strict s)
     env rec_flag spat_sexp_list scope allow =
+  let open Ast_helper in
   begin_def();
   if !Clflags.principal then begin_def ();
 
   let is_fake_let =
     match spat_sexp_list with
-    | [_, {pexp_desc=Pexp_match(
-           {pexp_desc=Pexp_ident({ txt = Longident.Lident "*opt*"})},_)}] ->
+    | [{pvb_expr={pexp_desc=Pexp_match(
+           {pexp_desc=Pexp_ident({ txt = Longident.Lident "*opt*"})},_)}}] ->
         true (* the fake let-declaration introduced by fun ?(x = e) -> ... *)
     | _ ->
         false
@@ -3256,15 +3380,17 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
 
   let spatl =
     List.map
-      (fun (spat, sexp) ->
+      (fun {pvb_pat=spat; pvb_expr=sexp; pvb_attributes=_} ->
         match spat.ppat_desc, sexp.pexp_desc with
           (Ppat_any | Ppat_constraint _), _ -> spat
-        | _, Pexp_constraint (_, _, Some sty)
-        | _, Pexp_constraint (_, Some sty, None) when !Clflags.principal ->
+        | _, Pexp_coerce (_, _, sty)
+        | _, Pexp_constraint (_, sty) when !Clflags.principal ->
             (* propagate type annotation to pattern,
                to allow it to be generalized in -principal mode *)
-            {ppat_desc = Ppat_constraint (spat, sty);
-             ppat_loc = {spat.ppat_loc with Location.loc_ghost=true}}
+            Pat.constraint_
+              ~loc:{spat.ppat_loc with Location.loc_ghost=true}
+              spat
+              sty
         | _ -> spat)
       spat_sexp_list in
   let nvs = List.map (fun _ -> newvar ()) spatl in
@@ -3274,14 +3400,14 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
   (* If recursive, first unify with an approximation of the expression *)
   if is_recursive then
     List.iter2
-      (fun pat (_, sexp) ->
+      (fun pat binding ->
         let pat =
           match pat.pat_type.desc with
           | Tpoly (ty, tl) ->
               {pat with pat_type =
                snd (instance_poly ~keep_names:true false tl ty)}
           | _ -> pat
-        in unify_pat env pat (type_approx env sexp))
+        in unify_pat env pat (type_approx env binding.pvb_expr))
       pat_list spat_sexp_list;
   (* Polymorphic variant processing *)
   List.iter
@@ -3370,7 +3496,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
   in
   let exp_list =
     List.map2
-      (fun (spat, sexp) (pat, slot) ->
+      (fun {pvb_expr=sexp; _} (pat, slot) ->
         let sexp =
           if rec_flag = Recursive then wrap_unpacks sexp unpacks else sexp in
         if is_recursive then current_slot := slot;
@@ -3392,10 +3518,10 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
   current_slot := None;
   if is_recursive && not !rec_needed
   && Warnings.is_active Warnings.Unused_rec_flag then
-    Location.prerr_warning (fst (List.hd spat_sexp_list)).ppat_loc
+    Location.prerr_warning (List.hd spat_sexp_list).pvb_pat.ppat_loc
       Warnings.Unused_rec_flag;
   List.iter2
-    (fun pat exp -> ignore(Parmatch.check_partial pat.pat_loc [pat, exp]))
+    (fun pat exp -> ignore(Parmatch.check_partial pat.pat_loc [case pat exp]))
     pat_list exp_list;
   end_def();
   List.iter2
@@ -3406,7 +3532,13 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
   List.iter
     (fun pat -> iter_pattern (fun pat -> generalize pat.pat_type) pat)
     pat_list;
-  (List.combine pat_list exp_list, new_env, unpacks)
+  let l = List.combine pat_list exp_list in
+  let l =
+    List.map2
+      (fun (p, e) pvb -> {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes})
+      l spat_sexp_list
+  in
+  (l, new_env, unpacks)
 
 (* Typing of toplevel bindings *)
 
@@ -3638,6 +3770,10 @@ let report_error env ppf = function
       fprintf ppf "@[The GADT constructor %s of type %a@ %s.@]"
         name path tpath
         "must be qualified in this pattern"
+  | Invalid_interval ->
+      fprintf ppf "@[Only character intervals are supported in patterns.@]"
+  | Extension s ->
+      fprintf ppf "Uninterpreted extension '%s'." s
 
 let report_error env ppf err =
   wrap_printing_env env (fun () -> report_error env ppf err)
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 30093733a..e5e8516da 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -20,14 +20,14 @@ val is_nonexpansive: Typedtree.expression -> bool
 
 val type_binding:
         Env.t -> rec_flag ->
-          (Parsetree.pattern * Parsetree.expression) list ->
+          Parsetree.value_binding list ->
           Annot.ident option ->
-          (Typedtree.pattern * Typedtree.expression) list * Env.t
+          Typedtree.value_binding list * Env.t
 val type_let:
         Env.t -> rec_flag ->
-          (Parsetree.pattern * Parsetree.expression) list ->
+          Parsetree.value_binding list ->
           Annot.ident option ->
-          (Typedtree.pattern * Typedtree.expression) list * Env.t
+          Typedtree.value_binding list * Env.t
 val type_expression:
         Env.t -> Parsetree.expression -> Typedtree.expression
 val type_class_arg_pattern:
@@ -105,6 +105,8 @@ type error =
   | Recursive_local_constraint of (type_expr * type_expr) list
   | Unexpected_existential
   | Unqualified_gadt_pattern of Path.t * string
+  | Invalid_interval
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 832553743..55b81d4bf 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -40,6 +40,7 @@ type error =
   | Bad_fixed_type of string
   | Unbound_type_var_exc of type_expr * type_expr
   | Varying_anonymous
+  | Exception_constructor_with_result
 
 open Typedtree
 
@@ -47,7 +48,7 @@ exception Error of Location.t * error
 
 (* Enter all declared types in the environment as abstract types *)
 
-let enter_type env (name, sdecl) id =
+let enter_type env sdecl id =
   let decl =
     { type_params =
         List.map (fun _ -> Btype.newgenvar ()) sdecl.ptype_params;
@@ -126,14 +127,15 @@ module StringSet =
 let make_params sdecl =
   try
     List.map
-      (function
-          None -> Ctype.new_global_var ~name:"_" ()
-        | Some x -> enter_type_variable true sdecl.ptype_loc x.txt)
+      (fun (x, _) ->
+        match x with
+        | None -> Ctype.new_global_var ~name:"_" ()
+        | Some x -> enter_type_variable x)
       sdecl.ptype_params
-  with Already_bound ->
-    raise(Error(sdecl.ptype_loc, Repeated_parameter))
+  with Already_bound loc ->
+    raise(Error(loc, Repeated_parameter))
 
-let transl_declaration env (name, sdecl) id =
+let transl_declaration env sdecl id =
   (* Bind type parameters *)
   reset_type_variables();
   Ctype.begin_def ();
@@ -150,29 +152,29 @@ let transl_declaration env (name, sdecl) id =
       | Ptype_variant cstrs ->
         let all_constrs = ref StringSet.empty in
         List.iter
-          (fun ({ txt = name}, _, _, loc) ->
+          (fun {pcd_name = {txt = name}} ->
             if StringSet.mem name !all_constrs then
               raise(Error(sdecl.ptype_loc, Duplicate_constructor name));
             all_constrs := StringSet.add name !all_constrs)
           cstrs;
         if List.length
-          (List.filter (fun (_, args, _, _) -> args <> []) cstrs)
+          (List.filter (fun cd -> cd.pcd_args <> []) cstrs)
           > (Config.max_tag + 1) then
           raise(Error(sdecl.ptype_loc, Too_many_constructors));
-        let make_cstr (lid, args, ret_type, loc) =
+        let make_cstr {pcd_name = lid; pcd_args = args; pcd_res = ret_type; pcd_loc = loc; pcd_attributes = attrs} =
           let name = Ident.create lid.txt in
           match ret_type with
             | None ->
               (name, lid, List.map (transl_simple_type env true) args,
-               None, loc)
+               None, None, loc, attrs)
             | Some sty ->
               (* if it's a generalized constructor we must first narrow and
                  then widen so as to not introduce any new constraints *)
               let z = narrow () in
               reset_type_variables ();
               let args = List.map (transl_simple_type env false) args in
+              let cty = transl_simple_type env false sty in
               let ret_type =
-                let cty = transl_simple_type env false sty in
                 let ty = cty.ctyp_type in
                 let p = Path.Pident id in
                 match (Ctype.repr ty).desc with
@@ -182,32 +184,35 @@ let transl_declaration env (name, sdecl) id =
                                     (ty, Ctype.newconstr p params)))
               in
               widen z;
-              (name, lid, args, Some ret_type, loc)
+              (name, lid, args, Some cty, Some ret_type, loc, attrs)
         in
         let cstrs = List.map make_cstr cstrs in
-        Ttype_variant (List.map (fun (name, lid, ctys, _, loc) ->
-          name, lid, ctys, loc
+        Ttype_variant (List.map (fun (name, lid, ctys, res, _, loc, attrs) ->
+          {cd_id = name; cd_name = lid; cd_args = ctys; cd_res = res;
+           cd_loc = loc; cd_attributes = attrs}
         ) cstrs),
-        Type_variant (List.map (fun (name, name_loc, ctys, option, loc) ->
+        Type_variant (List.map (fun (name, name_loc, ctys, _, option, loc, _attrs) ->
           name, List.map (fun cty -> cty.ctyp_type) ctys, option) cstrs)
 
       | Ptype_record lbls ->
         let all_labels = ref StringSet.empty in
         List.iter
-          (fun ({ txt = name }, mut, arg, loc) ->
+          (fun {pld_name = {txt=name}} ->
             if StringSet.mem name !all_labels then
               raise(Error(sdecl.ptype_loc, Duplicate_label name));
             all_labels := StringSet.add name !all_labels)
           lbls;
-        let lbls = List.map (fun (name, mut, arg, loc) ->
+        let lbls = List.map (fun {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc;pld_attributes=attrs} ->
+          let arg = Ast_helper.Typ.force_poly arg in
           let cty = transl_simple_type env true arg in
-          (Ident.create name.txt, name, mut, cty, loc)
-        ) lbls in
+          {ld_id = Ident.create name.txt; ld_name = name; ld_mutable = mut; ld_type = cty;
+           ld_loc = loc; ld_attributes = attrs}
+          ) lbls in
         let lbls' =
           List.map
-            (fun (name, name_loc, mut, cty, loc) ->
-              let ty = cty.ctyp_type in
-              name, mut, match ty.desc with Tpoly(t,[]) -> t | _ -> ty)
+            (fun ld ->
+              let ty = ld.ld_type.ctyp_type in
+              ld.ld_id, ld.ld_mutable, match ty.desc with Tpoly(t,[]) -> t | _ -> ty)
             lbls in
         let rep =
           if List.for_all (fun (name, mut, arg) -> is_float env arg) lbls'
@@ -253,19 +258,20 @@ let transl_declaration env (name, sdecl) id =
     begin match decl.type_manifest with None -> ()
       | Some ty ->
         if Ctype.cyclic_abbrev env id ty then
-          raise(Error(sdecl.ptype_loc, Recursive_abbrev name.txt));
+          raise(Error(sdecl.ptype_loc, Recursive_abbrev sdecl.ptype_name.txt));
     end;
-    let tdecl = {
+    {
+      typ_id = id;
+      typ_name = sdecl.ptype_name;
       typ_params = sdecl.ptype_params;
       typ_type = decl;
       typ_cstrs = cstrs;
       typ_loc = sdecl.ptype_loc;
       typ_manifest = tman;
       typ_kind = tkind;
-      typ_variance = sdecl.ptype_variance;
       typ_private = sdecl.ptype_private;
-    } in
-    (id, name, tdecl)
+      typ_attributes = sdecl.ptype_attributes;
+    }
 
 (* Generalize a type declaration *)
 
@@ -316,7 +322,7 @@ let rec check_constraints_rec env loc visited ty =
 
 module SMap = Map.Make(String)
 
-let check_constraints env (_, sdecl) (_, decl) =
+let check_constraints env sdecl (_, decl) =
   let visited = ref TypeSet.empty in
   begin match decl.type_kind with
   | Type_abstract -> ()
@@ -327,14 +333,14 @@ let check_constraints env (_, sdecl) (_, decl) =
       in
       let pl = find_pl sdecl.ptype_kind in
       let pl_index =
-        let foldf acc (name, styl, sret_type, _) =
-          SMap.add name.txt (styl, sret_type) acc
+        let foldf acc x =
+          SMap.add x.pcd_name.txt x acc
         in
         List.fold_left foldf SMap.empty pl
       in
       List.iter
         (fun (name, tyl, ret_type) ->
-          let (styl, sret_type) =
+          let {pcd_args = styl; pcd_res = sret_type; _} =
             try SMap.find (Ident.name name) pl_index
             with Not_found -> assert false in
           List.iter2
@@ -355,8 +361,8 @@ let check_constraints env (_, sdecl) (_, decl) =
       let pl = find_pl sdecl.ptype_kind in
       let rec get_loc name = function
           [] -> assert false
-        | (name', _, sty, _) :: tl ->
-            if name = name'.txt then sty.ptyp_loc else get_loc name tl
+        | pld :: tl ->
+            if name = pld.pld_name.txt then pld.pld_type.ptyp_loc else get_loc name tl
       in
       List.iter
         (fun (name, _, ty) ->
@@ -406,7 +412,7 @@ let check_coherence env loc id decl =
       end
   | _ -> ()
 
-let check_abbrev env (_, sdecl) (id, decl) =
+let check_abbrev env sdecl (id, decl) =
   check_coherence env sdecl.ptype_loc id decl
 
 (* Check that recursion is well-founded *)
@@ -478,8 +484,9 @@ let check_recursion env loc path decl to_check =
       check_regular path args [] body)
     decl.type_manifest
 
-let check_abbrev_recursion env id_loc_list (id, _, tdecl) =
+let check_abbrev_recursion env id_loc_list tdecl =
   let decl = tdecl.typ_type in
+  let id = tdecl.typ_id in
   check_recursion env (List.assoc id id_loc_list) (Path.Pident id) decl
     (function Path.Pident id -> List.mem_assoc id id_loc_list | _ -> false)
 
@@ -587,6 +594,15 @@ let make p n i =
   let open Variance in
   set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
 
+let flags (v, i) =
+  let (c, n) =
+    match v with
+    | Covariant -> (true, false)
+    | Contravariant -> (false, true)
+    | Invariant -> (true, true)
+  in
+  (c, n, i)
+
 let compute_variance_type env check (required, loc) decl tyl =
   (* Requirements *)
   let required =
@@ -786,15 +802,22 @@ let rec compute_variance_fixpoint env decls required variances =
 let init_variance (id, decl) =
   List.map (fun _ -> Variance.null) decl.type_params
 
-let add_injectivity = List.map (fun (cn,cv) -> (cn,cv,false))
+let add_injectivity =
+  List.map
+    (function
+      | Covariant -> (true, false, false)
+      | Contravariant -> (false, true, false)
+      | Invariant -> (false, false, false)
+    )
 
 (* for typeclass.ml *)
 let compute_variance_decls env cldecls =
   let decls, required =
     List.fold_right
       (fun (obj_id, obj_abbr, cl_abbr, clty, cltydef, ci) (decls, req) ->
+        let variance = List.map snd ci.ci_params in
         (obj_id, obj_abbr) :: decls,
-        (add_injectivity ci.ci_variance, ci.ci_loc) :: req)
+        (add_injectivity variance, ci.ci_loc) :: req)
       cldecls ([],[])
   in
   let variances = List.map init_variance decls in
@@ -809,32 +832,32 @@ let compute_variance_decls env cldecls =
 
 (* Check multiple declarations of labels/constructors *)
 
-let check_duplicates name_sdecl_list =
+let check_duplicates sdecl_list =
   let labels = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
   List.iter
-    (fun (name, sdecl) -> match sdecl.ptype_kind with
+    (fun sdecl -> match sdecl.ptype_kind with
       Ptype_variant cl ->
         List.iter
-          (fun (cname, _, _, loc) ->
+          (fun pcd ->
             try
-              let name' = Hashtbl.find constrs cname.txt in
-              Location.prerr_warning loc
+              let name' = Hashtbl.find constrs pcd.pcd_name.txt in
+              Location.prerr_warning pcd.pcd_loc
                 (Warnings.Duplicate_definitions
-                   ("constructor", cname.txt, name', name.txt))
-            with Not_found -> Hashtbl.add constrs cname.txt name.txt)
+                   ("constructor", pcd.pcd_name.txt, name', sdecl.ptype_name.txt))
+            with Not_found -> Hashtbl.add constrs pcd.pcd_name.txt sdecl.ptype_name.txt)
           cl
     | Ptype_record fl ->
         List.iter
-          (fun (cname, _, _, loc) ->
+          (fun {pld_name=cname;pld_loc=loc} ->
             try
               let name' = Hashtbl.find labels cname.txt in
               Location.prerr_warning loc
                 (Warnings.Duplicate_definitions
-                   ("label", cname.txt, name', name.txt))
-            with Not_found -> Hashtbl.add labels cname.txt name.txt)
+                   ("label", cname.txt, name', sdecl.ptype_name.txt))
+            with Not_found -> Hashtbl.add labels cname.txt sdecl.ptype_name.txt)
           fl
     | Ptype_abstract -> ())
-    name_sdecl_list
+    sdecl_list
 
 (* Force recursion to go through id for private types*)
 let name_recursion sdecl id decl =
@@ -852,22 +875,20 @@ let name_recursion sdecl id decl =
   | _ -> decl
 
 (* Translate a set of mutually recursive type declarations *)
-let transl_type_decl env name_sdecl_list =
+let transl_type_decl env sdecl_list =
   (* Add dummy types for fixed rows *)
-  let fixed_types =
-    List.filter (fun (_, sd) -> is_fixed_type sd) name_sdecl_list
-  in
-  let name_sdecl_list =
+  let fixed_types = List.filter is_fixed_type sdecl_list in
+  let sdecl_list =
     List.map
-      (fun (name, sdecl) ->
-        mkloc (name.txt ^"#row") name.loc,
-        {sdecl with ptype_kind = Ptype_abstract; ptype_manifest = None})
+      (fun sdecl ->
+        let ptype_name =  mkloc (sdecl.ptype_name.txt ^"#row") sdecl.ptype_name.loc in
+        {sdecl with ptype_name; ptype_kind = Ptype_abstract; ptype_manifest = None})
       fixed_types
-    @ name_sdecl_list
+    @ sdecl_list
   in
   (* Create identifiers. *)
   let id_list =
-    List.map (fun (name, _) -> Ident.create name.txt) name_sdecl_list
+    List.map (fun sdecl -> Ident.create sdecl.ptype_name.txt) sdecl_list
   in
   (*
      Since we've introduced fresh idents, make sure the definition
@@ -878,7 +899,7 @@ let transl_type_decl env name_sdecl_list =
   Ctype.init_def(Ident.current_time());
   Ctype.begin_def();
   (* Enter types. *)
-  let temp_env = List.fold_left2 enter_type env name_sdecl_list id_list in
+  let temp_env = List.fold_left2 enter_type env sdecl_list id_list in
   (* Translate each declaration. *)
   let current_slot = ref None in
   let warn_unused = Warnings.is_active (Warnings.Unused_type_declaration "") in
@@ -905,12 +926,12 @@ let transl_type_decl env name_sdecl_list =
   let transl_declaration name_sdecl (id, slot) =
     current_slot := slot; transl_declaration temp_env name_sdecl id in
   let tdecls =
-    List.map2 transl_declaration name_sdecl_list (List.map id_slots id_list) in
+    List.map2 transl_declaration sdecl_list (List.map id_slots id_list) in
   let decls =
-    List.map (fun (id, name_loc, tdecl) -> (id, tdecl.typ_type)) tdecls in
+    List.map (fun tdecl -> (tdecl.typ_id, tdecl.typ_type)) tdecls in
   current_slot := None;
   (* Check for duplicates *)
-  check_duplicates name_sdecl_list;
+  check_duplicates sdecl_list;
   (* Build the final env. *)
   let newenv =
     List.fold_right
@@ -919,15 +940,15 @@ let transl_type_decl env name_sdecl_list =
   in
   (* Update stubs *)
   List.iter2
-    (fun id (_, sdecl) -> update_type temp_env newenv id sdecl.ptype_loc)
-    id_list name_sdecl_list;
+    (fun id sdecl -> update_type temp_env newenv id sdecl.ptype_loc)
+    id_list sdecl_list;
   (* Generalize type declarations. *)
   Ctype.end_def();
   List.iter (fun (_, decl) -> generalize_decl decl) decls;
   (* Check for ill-formed abbrevs *)
   let id_loc_list =
-    List.map2 (fun id (_,sdecl) -> (id, sdecl.ptype_loc))
-      id_list name_sdecl_list
+    List.map2 (fun id sdecl -> (id, sdecl.ptype_loc))
+      id_list sdecl_list
   in
   List.iter (fun (id, decl) ->
     check_well_founded newenv (List.assoc id id_loc_list) (Path.Pident id) decl)
@@ -935,35 +956,40 @@ let transl_type_decl env name_sdecl_list =
   List.iter (check_abbrev_recursion newenv id_loc_list) tdecls;
   (* Check that all type variable are closed *)
   List.iter2
-    (fun (_, sdecl) (id, _, tdecl) ->
+    (fun sdecl tdecl ->
       let decl = tdecl.typ_type in
        match Ctype.closed_type_decl decl with
          Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
        | None   -> ())
-    name_sdecl_list tdecls;
+    sdecl_list tdecls;
   (* Check that constraints are enforced *)
-  List.iter2 (check_constraints newenv) name_sdecl_list decls;
+  List.iter2 (check_constraints newenv) sdecl_list decls;
   (* Name recursion *)
   let decls =
-    List.map2 (fun (_, sdecl) (id, decl) ->
-        id, name_recursion sdecl id decl)
-      name_sdecl_list decls
+    List.map2 (fun sdecl (id, decl) -> id, name_recursion sdecl id decl)
+      sdecl_list decls
   in
   (* Add variances to the environment *)
   let required =
     List.map
-      (fun (_, sdecl) -> add_injectivity sdecl.ptype_variance, sdecl.ptype_loc)
-      name_sdecl_list
+      (fun sdecl ->
+         add_injectivity (List.map snd sdecl.ptype_params),
+         sdecl.ptype_loc
+      )
+      sdecl_list
   in
   let final_decls, final_env =
     compute_variance_fixpoint env decls required (List.map init_variance decls)
   in
   (* Check re-exportation *)
-  List.iter2 (check_abbrev final_env) name_sdecl_list final_decls;
+  List.iter2 (check_abbrev final_env) sdecl_list final_decls;
   (* Keep original declaration *)
-  let final_decls = List.map2 (fun (id, name_loc, tdecl) (id2, decl) ->
-        (id, name_loc, { tdecl with typ_type = decl })
-    ) tdecls final_decls in
+  let final_decls =
+    List.map2
+      (fun tdecl (id2, decl) ->
+        { tdecl with typ_type = decl }
+      ) tdecls final_decls
+  in
   (* Done *)
   (final_decls, final_env)
 
@@ -978,15 +1004,27 @@ let transl_closed_type env sty =
   in
   { cty with ctyp_type = ty }
 
-let transl_exception env loc excdecl =
+let transl_exception env excdecl =
+  let loc = excdecl.pcd_loc in
+  if excdecl.pcd_res <> None then raise (Error (loc, Exception_constructor_with_result));
   reset_type_variables();
   Ctype.begin_def();
-  let ttypes = List.map (transl_closed_type env) excdecl in
+  let ttypes = List.map (transl_closed_type env) excdecl.pcd_args in
   Ctype.end_def();
   let types = List.map (fun cty -> cty.ctyp_type) ttypes in
   List.iter Ctype.generalize types;
   let exn_decl = { exn_args = types; Types.exn_loc = loc } in
-  { exn_params = ttypes; exn_exn = exn_decl; Typedtree.exn_loc = loc }
+  let (id, newenv) = Env.enter_exception excdecl.pcd_name.txt exn_decl env in
+  let cd =
+    { cd_id = id;
+      cd_name = excdecl.pcd_name;
+      cd_args = ttypes;
+      cd_loc = loc;
+      cd_res = None;
+      cd_attributes = excdecl.pcd_attributes;
+     }
+  in
+  cd, exn_decl, newenv
 
 (* Translate an exception rebinding *)
 let transl_exn_rebind env loc lid =
@@ -1020,9 +1058,21 @@ let transl_value_decl env loc valdecl =
       then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
       { val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc }
   in
-  { val_desc = cty; val_val = v;
-    val_prim = valdecl.pval_prim;
-    val_loc = valdecl.pval_loc; }
+  let (id, newenv) =
+    Env.enter_value valdecl.pval_name.txt v env
+      ~check:(fun s -> Warnings.Unused_value_declaration s)
+  in
+  let desc =
+    {
+     val_id = id;
+     val_name = valdecl.pval_name;
+     val_desc = cty; val_val = v;
+     val_prim = valdecl.pval_prim;
+     val_loc = valdecl.pval_loc;
+     val_attributes = valdecl.pval_attributes;
+    }
+  in
+  desc, newenv
 
 (* Translate a "with" constraint -- much simplified version of
     transl_type_decl. *)
@@ -1085,18 +1135,20 @@ let transl_with_constraint env id row_path orig_decl sdecl =
   let decl =
     {decl with type_variance =
      compute_variance_decl env false decl
-       (add_injectivity sdecl.ptype_variance, sdecl.ptype_loc)} in
+       (add_injectivity (List.map snd sdecl.ptype_params), sdecl.ptype_loc)} in
   Ctype.end_def();
   generalize_decl decl;
   {
+    typ_id = id;
+    typ_name = sdecl.ptype_name;
     typ_params = sdecl.ptype_params;
     typ_type = decl;
     typ_cstrs = constraints;
     typ_loc = sdecl.ptype_loc;
     typ_manifest = tman;
     typ_kind = Ttype_abstract;
-    typ_variance = sdecl.ptype_variance;
     typ_private = sdecl.ptype_private;
+    typ_attributes = sdecl.ptype_attributes;
   }
 
 (* Approximate a type declaration: just make all types abstract *)
@@ -1119,12 +1171,12 @@ let abstract_type_decl arity =
   generalize_decl decl;
   decl
 
-let approx_type_decl env name_sdecl_list =
+let approx_type_decl env sdecl_list =
   List.map
-    (fun (name, sdecl) ->
-      (Ident.create name.txt,
+    (fun sdecl ->
+      (Ident.create sdecl.ptype_name.txt,
        abstract_type_decl (List.length sdecl.ptype_params)))
-    name_sdecl_list
+    sdecl_list
 
 (* Variant of check_abbrev_recursion to check the well-formedness
    conditions on type abbreviations defined within recursive modules. *)
@@ -1290,3 +1342,5 @@ let report_error ppf = function
       fprintf ppf "@[%s@ %s@ %s@]"
         "In this GADT definition," "the variance of some parameter"
         "cannot be checked"
+  | Exception_constructor_with_result ->
+      fprintf ppf "Exception constructors cannot specify a result type"
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index 869438e64..89eb07517 100644
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -12,24 +12,23 @@
 
 (* Typing of type definitions and primitive definitions *)
 
-open Asttypes
 open Types
 open Format
 
 val transl_type_decl:
-    Env.t -> (string loc * Parsetree.type_declaration) list ->
-    (Ident.t * string Asttypes.loc * Typedtree.type_declaration) list * Env.t
+    Env.t -> Parsetree.type_declaration list ->
+    Typedtree.type_declaration list * Env.t
 
 val transl_exception:
-    Env.t -> Location.t ->
-    Parsetree.exception_declaration -> Typedtree.exception_declaration
+    Env.t ->
+    Parsetree.constructor_declaration -> Typedtree.constructor_declaration * exception_declaration * Env.t
 
 val transl_exn_rebind:
     Env.t -> Location.t -> Longident.t -> Path.t * exception_declaration
 
 val transl_value_decl:
     Env.t -> Location.t ->
-    Parsetree.value_description -> Typedtree.value_description
+    Parsetree.value_description -> Typedtree.value_description * Env.t
 
 val transl_with_constraint:
     Env.t -> Ident.t -> Path.t option -> Types.type_declaration ->
@@ -37,7 +36,7 @@ val transl_with_constraint:
 
 val abstract_type_decl: int -> type_declaration
 val approx_type_decl:
-    Env.t -> (string loc * Parsetree.type_declaration) list ->
+    Env.t -> Parsetree.type_declaration list ->
                                   (Ident.t * type_declaration) list
 val check_recmod_typedecl:
     Env.t -> Location.t -> Ident.t list -> Path.t -> type_declaration -> unit
@@ -77,6 +76,7 @@ type error =
   | Bad_fixed_type of string
   | Unbound_type_var_exc of type_expr * type_expr
   | Varying_anonymous
+  | Exception_constructor_with_result
 
 exception Error of Location.t * error
 
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 405e56bd5..35c5f5c5e 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -21,12 +21,17 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
 type pattern =
   { pat_desc: pattern_desc;
     pat_loc: Location.t;
-    pat_extra : (pat_extra * Location.t) list;
+    pat_extra : (pat_extra * Location.t * attribute list) list;
     pat_type: type_expr;
-    mutable pat_env: Env.t }
+    mutable pat_env: Env.t;
+    pat_attributes: attribute list;
+   }
 
 and pat_extra =
   | Tpat_constraint of core_type
@@ -40,7 +45,7 @@ and pattern_desc =
   | Tpat_constant of constant
   | Tpat_tuple of pattern list
   | Tpat_construct of
-      Longident.t loc * constructor_description * pattern list * bool
+      Longident.t loc * constructor_description * pattern list
   | Tpat_variant of label * pattern option * row_desc ref
   | Tpat_record of
       (Longident.t loc * label_description * pattern) list *
@@ -52,12 +57,15 @@ and pattern_desc =
 and expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
-    exp_extra : (exp_extra * Location.t) list;
+    exp_extra: (exp_extra * Location.t * attribute list) list;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+    exp_attributes: attribute list;
+   }
 
 and exp_extra =
-  | Texp_constraint of core_type option * core_type option
+  | Texp_constraint of core_type
+  | Texp_coerce of core_type option * core_type
   | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
   | Texp_poly of core_type option
   | Texp_newtype of string
@@ -65,15 +73,14 @@ and exp_extra =
 and expression_desc =
     Texp_ident of Path.t * Longident.t loc * Types.value_description
   | Texp_constant of constant
-  | Texp_let of rec_flag * (pattern * expression) list * expression
-  | Texp_function of label * (pattern * expression) list * partial
+  | Texp_let of rec_flag * value_binding list * expression
+  | Texp_function of label * case list * partial
   | Texp_apply of expression * (label * expression option * optional) list
-  | Texp_match of expression * (pattern * expression) list * partial
-  | Texp_try of expression * (pattern * expression) list
+  | Texp_match of expression * case list * partial
+  | Texp_try of expression * case list
   | Texp_tuple of expression list
   | Texp_construct of
-      Longident.t loc * constructor_description * expression list *
-        bool
+      Longident.t loc * constructor_description * expression list
   | Texp_variant of label * expression option
   | Texp_record of
       (Longident.t loc * label_description * expression) list *
@@ -88,7 +95,6 @@ and expression_desc =
   | Texp_for of
       Ident.t * string loc * expression * expression * direction_flag *
         expression
-  | Texp_when of expression * expression
   | Texp_send of expression * meth * expression option
   | Texp_new of Path.t * Longident.t loc * Types.class_declaration
   | Texp_instvar of Path.t * Path.t * string loc
@@ -96,7 +102,6 @@ and expression_desc =
   | Texp_override of Path.t * (Path.t * string loc * expression) list
   | Texp_letmodule of Ident.t * string loc * module_expr * expression
   | Texp_assert of expression
-  | Texp_assertfalse
   | Texp_lazy of expression
   | Texp_object of class_structure * string list
   | Texp_pack of module_expr
@@ -105,56 +110,65 @@ and meth =
     Tmeth_name of string
   | Tmeth_val of Ident.t
 
+and case =
+    {
+     c_lhs: pattern;
+     c_guard: expression option;
+     c_rhs: expression;
+    }
+
 (* Value expressions for the class language *)
 
 and class_expr =
-  { cl_desc: class_expr_desc;
-    cl_loc: Location.t;
-    cl_type: Types.class_type;
-    cl_env: Env.t }
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attribute list;
+    }
 
 and class_expr_desc =
-    Tcl_ident of Path.t * Longident.t loc * core_type list (* Pcl_constr *)
+    Tcl_ident of Path.t * Longident.t loc * core_type list
   | Tcl_structure of class_structure
   | Tcl_fun of
       label * pattern * (Ident.t * string loc * expression) list * class_expr *
         partial
   | Tcl_apply of class_expr * (label * expression option * optional) list
-  | Tcl_let of rec_flag *  (pattern * expression) list *
+  | Tcl_let of rec_flag * value_binding list *
                   (Ident.t * string loc * expression) list * class_expr
   | Tcl_constraint of
       class_expr * class_type option * string list * string list * Concr.t
     (* Visible instance variables, methods and concretes methods *)
 
 and class_structure =
-  { cstr_pat : pattern;
-    cstr_fields: class_field list;
-    cstr_type : Types.class_signature;
-    cstr_meths: Ident.t Meths.t }
+  {
+   cstr_self: pattern;
+   cstr_fields: class_field list;
+   cstr_type: Types.class_signature;
+   cstr_meths: Ident.t Meths.t;
+  }
 
 and class_field =
    {
-    cf_desc : class_field_desc;
-    cf_loc : Location.t;
+    cf_desc: class_field_desc;
+    cf_loc: Location.t;
+    cf_attributes: attribute list;
   }
 
 and class_field_kind =
-  Tcfk_virtual of core_type
-| Tcfk_concrete of expression
+  | Tcfk_virtual of core_type
+  | Tcfk_concrete of override_flag * expression
 
 and class_field_desc =
-    Tcf_inher of
+    Tcf_inherit of
       override_flag * class_expr * string option * (string * Ident.t) list *
         (string * Ident.t) list
     (* Inherited instance variables and concrete methods *)
-  | Tcf_val of
-      string * string loc * mutable_flag * Ident.t * class_field_kind * bool
-        (* None = virtual, true = override *)
-  | Tcf_meth of string * string loc * private_flag * class_field_kind * bool
-  | Tcf_constr of core_type * core_type
-(*  | Tcf_let of rec_flag * (pattern * expression) list *
-              (Ident.t * string loc * expression) list *)
-  | Tcf_init of expression
+  | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+  | Tcf_method of string loc * private_flag * class_field_kind
+  | Tcf_constraint of core_type * core_type
+  | Tcf_initializer of expression
 
 (* Value expressions for the module language *)
 
@@ -162,7 +176,9 @@ and module_expr =
   { mod_desc: module_expr_desc;
     mod_loc: Location.t;
     mod_type: Types.module_type;
-    mod_env: Env.t }
+    mod_env: Env.t;
+    mod_attributes: attribute list;
+   }
 
 and module_type_constraint =
   Tmodtype_implicit
@@ -190,19 +206,35 @@ and structure_item =
   }
 
 and structure_item_desc =
-    Tstr_eval of expression
-  | Tstr_value of rec_flag * (pattern * expression) list
-  | Tstr_primitive of Ident.t * string loc * value_description
-  | Tstr_type of (Ident.t * string loc * type_declaration) list
-  | Tstr_exception of Ident.t * string loc * exception_declaration
-  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc
-  | Tstr_module of Ident.t * string loc * module_expr
-  | Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
-  | Tstr_modtype of Ident.t * string loc * module_type
-  | Tstr_open of override_flag * Path.t * Longident.t loc
+    Tstr_eval of expression * attributes
+  | Tstr_value of rec_flag * value_binding list
+  | Tstr_primitive of value_description
+  | Tstr_type of type_declaration list
+  | Tstr_exception of constructor_declaration
+  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc * attribute list
+  | Tstr_module of module_binding
+  | Tstr_recmodule of module_binding list
+  | Tstr_modtype of module_type_declaration
+  | Tstr_open of override_flag * Path.t * Longident.t loc * attribute list
   | Tstr_class of (class_declaration * string list * virtual_flag) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
-  | Tstr_include of module_expr * Types.signature
+  | Tstr_include of module_expr * Types.signature * attribute list
+  | Tstr_attribute of attribute
+
+and module_binding =
+    {
+     mb_id: Ident.t;
+     mb_name: string loc;
+     mb_expr: module_expr;
+     mb_attributes: attribute list;
+    }
+
+and value_binding =
+  {
+    vb_pat: pattern;
+    vb_expr: expression;
+    vb_attributes: attributes;
+  }
 
 and module_coercion =
     Tcoerce_none
@@ -213,8 +245,10 @@ and module_coercion =
 and module_type =
   { mty_desc: module_type_desc;
     mty_type : Types.module_type;
-    mty_env : Env.t; (* BINANNOT ADDED *)
-    mty_loc: Location.t }
+    mty_env : Env.t;
+    mty_loc: Location.t;
+    mty_attributes: attribute list;
+   }
 
 and module_type_desc =
     Tmty_ident of Path.t * Longident.t loc
@@ -235,20 +269,33 @@ and signature_item =
     sig_loc: Location.t }
 
 and signature_item_desc =
-    Tsig_value of Ident.t * string loc * value_description
-  | Tsig_type of (Ident.t * string loc * type_declaration) list
-  | Tsig_exception of Ident.t * string loc * exception_declaration
-  | Tsig_module of Ident.t * string loc * module_type
-  | Tsig_recmodule of (Ident.t * string loc * module_type) list
-  | Tsig_modtype of Ident.t * string loc * modtype_declaration
-  | Tsig_open of override_flag * Path.t * Longident.t loc
-  | Tsig_include of module_type * Types.signature
+    Tsig_value of value_description
+  | Tsig_type of type_declaration list
+  | Tsig_exception of constructor_declaration
+  | Tsig_module of module_declaration
+  | Tsig_recmodule of module_declaration list
+  | Tsig_modtype of module_type_declaration
+  | Tsig_open of override_flag * Path.t * Longident.t loc * attribute list
+  | Tsig_include of module_type * Types.signature * attribute list
   | Tsig_class of class_description list
   | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
+
+and module_declaration =
+    {
+     md_id: Ident.t;
+     md_name: string loc;
+     md_type: module_type;
+     md_attributes: attribute list;
+    }
 
-and modtype_declaration =
-    Tmodtype_abstract
-  | Tmodtype_manifest of module_type
+and module_type_declaration =
+    {
+     mtd_id: Ident.t;
+     mtd_name: string loc;
+     mtd_type: module_type option;
+     mtd_attributes: attribute list;
+    }
 
 and with_constraint =
     Twith_type of type_declaration
@@ -261,7 +308,9 @@ and core_type =
   { mutable ctyp_desc : core_type_desc;
     mutable ctyp_type : type_expr;
     ctyp_env : Env.t; (* BINANNOT ADDED *)
-    ctyp_loc : Location.t }
+    ctyp_loc : Location.t;
+    ctyp_attributes: attribute list;
+   }
 
 and core_type_desc =
     Ttyp_any
@@ -269,10 +318,10 @@ and core_type_desc =
   | Ttyp_arrow of label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
-  | Ttyp_object of core_field_type list
-  | Ttyp_class of Path.t * Longident.t loc * core_type list * label list
+  | Ttyp_object of (string * core_type) list * closed_flag
+  | Ttyp_class of Path.t * Longident.t loc * core_type list
   | Ttyp_alias of core_type * string
-  | Ttyp_variant of row_field list * bool * label list option
+  | Ttyp_variant of row_field list * closed_flag * label list option
   | Ttyp_poly of string list * core_type
   | Ttyp_package of package_type
 
@@ -283,75 +332,89 @@ and package_type = {
   pack_txt : Longident.t loc;
 }
 
-and core_field_type =
-  { field_desc: core_field_desc;
-    field_loc: Location.t }
-
-and core_field_desc =
-    Tcfield of string * core_type
-  | Tcfield_var
-
 and row_field =
     Ttag of label * bool * core_type list
   | Tinherit of core_type
 
 and value_description =
-  { val_desc : core_type;
-    val_val : Types.value_description;
-    val_prim : string list;
-    val_loc : Location.t;
+  { val_id: Ident.t;
+    val_name: string loc;
+    val_desc: core_type;
+    val_val: Types.value_description;
+    val_prim: string list;
+    val_loc: Location.t;
+    val_attributes: attribute list;
     }
 
 and type_declaration =
-  { typ_params: string loc option list;
-    typ_type : Types.type_declaration;
+  { typ_id: Ident.t;
+    typ_name: string loc;
+    typ_params: (string loc option * variance) list;
+    typ_type: Types.type_declaration;
     typ_cstrs: (core_type * core_type * Location.t) list;
     typ_kind: type_kind;
     typ_private: private_flag;
     typ_manifest: core_type option;
-    typ_variance: (bool * bool) list;
-    typ_loc: Location.t }
+    typ_loc: Location.t;
+    typ_attributes: attribute list;
+   }
 
 and type_kind =
     Ttype_abstract
-  | Ttype_variant of (Ident.t * string loc * core_type list * Location.t) list
-  | Ttype_record of
-      (Ident.t * string loc * mutable_flag * core_type * Location.t) list
+  | Ttype_variant of constructor_declaration list
+  | Ttype_record of label_declaration list
+
+and label_declaration =
+    {
+     ld_id: Ident.t;
+     ld_name: string loc;
+     ld_mutable: mutable_flag;
+     ld_type: core_type;
+     ld_loc: Location.t;
+     ld_attributes: attribute list;
+    }
 
-and exception_declaration =
-  { exn_params : core_type list;
-    exn_exn : Types.exception_declaration;
-    exn_loc : Location.t }
+and constructor_declaration =
+    {
+     cd_id: Ident.t;
+     cd_name: string loc;
+     cd_args: core_type list;
+     cd_res: core_type option;
+     cd_loc: Location.t;
+     cd_attributes: attribute list;
+    }
 
 and class_type =
-  { cltyp_desc: class_type_desc;
-    cltyp_type : Types.class_type;
-    cltyp_env : Env.t; (* BINANNOT ADDED *)
-    cltyp_loc: Location.t }
+    {
+     cltyp_desc: class_type_desc;
+     cltyp_type: Types.class_type;
+     cltyp_env: Env.t;
+     cltyp_loc: Location.t;
+     cltyp_attributes: attribute list;
+    }
 
 and class_type_desc =
     Tcty_constr of Path.t * Longident.t loc * core_type list
   | Tcty_signature of class_signature
-  | Tcty_fun of label * core_type * class_type
+  | Tcty_arrow of label * core_type * class_type
 
 and class_signature = {
     csig_self : core_type;
     csig_fields : class_type_field list;
     csig_type : Types.class_signature;
-    csig_loc : Location.t;
   }
 
 and class_type_field = {
-    ctf_desc : class_type_field_desc;
-    ctf_loc : Location.t;
+    ctf_desc: class_type_field_desc;
+    ctf_loc: Location.t;
+    ctf_attributes: attribute list;
   }
 
 and class_type_field_desc =
-    Tctf_inher of class_type
+  | Tctf_inherit of class_type
   | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
-  | Tctf_virt  of (string * private_flag * core_type)
-  | Tctf_meth  of (string * private_flag * core_type)
-  | Tctf_cstr  of (core_type * core_type)
+  | Tctf_method of (string * private_flag * virtual_flag * core_type)
+  | Tctf_constraint of (core_type * core_type)
 
 and class_declaration =
   class_expr class_infos
@@ -364,7 +427,7 @@ and class_type_declaration =
 
 and 'a class_infos =
   { ci_virt: virtual_flag;
-    ci_params: string loc list * Location.t;
+    ci_params: (string loc * variance) list;
     ci_id_name : string loc;
     ci_id_class: Ident.t;
     ci_id_class_type : Ident.t;
@@ -373,15 +436,16 @@ and 'a class_infos =
     ci_expr: 'a;
     ci_decl: Types.class_declaration;
     ci_type_decl : Types.class_type_declaration;
-    ci_variance: (bool * bool) list;
-    ci_loc: Location.t }
+    ci_loc: Location.t;
+    ci_attributes: attribute list;
+   }
 
 (* Auxiliary functions over the a.s.t. *)
 
 let iter_pattern_desc f = function
   | Tpat_alias(p, _, _) -> f p
   | Tpat_tuple patl -> List.iter f patl
-  | Tpat_construct(_, cstr, patl, _) -> List.iter f patl
+  | Tpat_construct(_, cstr, patl) -> List.iter f patl
   | Tpat_variant(_, pat, _) -> may f pat
   | Tpat_record (lbl_pat_list, _) ->
       List.iter (fun (_, lbl, pat) -> f pat) lbl_pat_list
@@ -400,8 +464,8 @@ let map_pattern_desc f d =
       Tpat_tuple (List.map f pats)
   | Tpat_record (lpats, closed) ->
       Tpat_record (List.map (fun (lid, l,p) -> lid, l, f p) lpats, closed)
-  | Tpat_construct (lid, c,pats, arity) ->
-      Tpat_construct (lid, c, List.map f pats, arity)
+  | Tpat_construct (lid, c,pats) ->
+      Tpat_construct (lid, c, List.map f pats)
   | Tpat_array pats ->
       Tpat_array (List.map f pats)
   | Tpat_lazy p1 -> Tpat_lazy (f p1)
@@ -431,9 +495,9 @@ let rec bound_idents pat =
 let pat_bound_idents pat =
   idents := []; bound_idents pat; let res = !idents in idents := []; res
 
-let rev_let_bound_idents_with_loc pat_expr_list =
+let rev_let_bound_idents_with_loc bindings =
   idents := [];
-  List.iter (fun (pat, expr) -> bound_idents pat) pat_expr_list;
+  List.iter (fun vb -> bound_idents vb.vb_pat) bindings;
   let res = !idents in idents := []; res
 
 let let_bound_idents_with_loc pat_expr_list =
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index a263c9093..b68d0cc8c 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -20,12 +20,17 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
+type attribute = Parsetree.attribute
+type attributes = attribute list
+
 type pattern =
   { pat_desc: pattern_desc;
     pat_loc: Location.t;
-    pat_extra : (pat_extra * Location.t) list;
+    pat_extra : (pat_extra * Location.t * attributes) list;
     pat_type: type_expr;
-    mutable pat_env: Env.t }
+    mutable pat_env: Env.t;
+    pat_attributes: attributes;
+   }
 
 and pat_extra =
   | Tpat_constraint of core_type
@@ -39,7 +44,7 @@ and pattern_desc =
   | Tpat_constant of constant
   | Tpat_tuple of pattern list
   | Tpat_construct of
-      Longident.t loc * constructor_description * pattern list * bool
+      Longident.t loc * constructor_description * pattern list
   | Tpat_variant of label * pattern option * row_desc ref
   | Tpat_record of
       (Longident.t loc * label_description * pattern) list *
@@ -51,12 +56,15 @@ and pattern_desc =
 and expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
-    exp_extra : (exp_extra * Location.t) list;
+    exp_extra: (exp_extra * Location.t * attributes) list;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+    exp_attributes: attributes;
+   }
 
 and exp_extra =
-  | Texp_constraint of core_type option * core_type option
+  | Texp_constraint of core_type
+  | Texp_coerce of core_type option * core_type
   | Texp_open of override_flag * Path.t * Longident.t loc * Env.t
   | Texp_poly of core_type option
   | Texp_newtype of string
@@ -64,15 +72,14 @@ and exp_extra =
 and expression_desc =
     Texp_ident of Path.t * Longident.t loc * Types.value_description
   | Texp_constant of constant
-  | Texp_let of rec_flag * (pattern * expression) list * expression
-  | Texp_function of label * (pattern * expression) list * partial
+  | Texp_let of rec_flag * value_binding list * expression
+  | Texp_function of label * case list * partial
   | Texp_apply of expression * (label * expression option * optional) list
-  | Texp_match of expression * (pattern * expression) list * partial
-  | Texp_try of expression * (pattern * expression) list
+  | Texp_match of expression * case list * partial
+  | Texp_try of expression * case list
   | Texp_tuple of expression list
   | Texp_construct of
-      Longident.t loc * constructor_description * expression list *
-        bool
+      Longident.t loc * constructor_description * expression list
   | Texp_variant of label * expression option
   | Texp_record of
       (Longident.t loc * label_description * expression) list *
@@ -87,7 +94,6 @@ and expression_desc =
   | Texp_for of
       Ident.t * string loc * expression * expression * direction_flag *
         expression
-  | Texp_when of expression * expression
   | Texp_send of expression * meth * expression option
   | Texp_new of Path.t * Longident.t loc * Types.class_declaration
   | Texp_instvar of Path.t * Path.t * string loc
@@ -95,7 +101,6 @@ and expression_desc =
   | Texp_override of Path.t * (Path.t * string loc * expression) list
   | Texp_letmodule of Ident.t * string loc * module_expr * expression
   | Texp_assert of expression
-  | Texp_assertfalse
   | Texp_lazy of expression
   | Texp_object of class_structure * string list
   | Texp_pack of module_expr
@@ -104,13 +109,23 @@ and meth =
     Tmeth_name of string
   | Tmeth_val of Ident.t
 
+and case =
+    {
+     c_lhs: pattern;
+     c_guard: expression option;
+     c_rhs: expression;
+    }
+
 (* Value expressions for the class language *)
 
 and class_expr =
-  { cl_desc: class_expr_desc;
-    cl_loc: Location.t;
-    cl_type: Types.class_type;
-    cl_env: Env.t }
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attributes;
+    }
 
 and class_expr_desc =
     Tcl_ident of Path.t * Longident.t loc * core_type list
@@ -119,41 +134,40 @@ and class_expr_desc =
       label * pattern * (Ident.t * string loc * expression) list * class_expr *
         partial
   | Tcl_apply of class_expr * (label * expression option * optional) list
-  | Tcl_let of rec_flag *  (pattern * expression) list *
+  | Tcl_let of rec_flag * value_binding list *
                   (Ident.t * string loc * expression) list * class_expr
   | Tcl_constraint of
       class_expr * class_type option * string list * string list * Concr.t
     (* Visible instance variables, methods and concretes methods *)
 
 and class_structure =
-  { cstr_pat : pattern;
-    cstr_fields: class_field list;
-    cstr_type : Types.class_signature;
-    cstr_meths: Ident.t Meths.t }
+  {
+   cstr_self: pattern;
+   cstr_fields: class_field list;
+   cstr_type: Types.class_signature;
+   cstr_meths: Ident.t Meths.t;
+  }
 
 and class_field =
    {
-    cf_desc : class_field_desc;
-    cf_loc : Location.t;
+    cf_desc: class_field_desc;
+    cf_loc: Location.t;
+    cf_attributes: attributes;
   }
 
 and class_field_kind =
-  Tcfk_virtual of core_type
-| Tcfk_concrete of expression
+  | Tcfk_virtual of core_type
+  | Tcfk_concrete of override_flag * expression
 
 and class_field_desc =
-    Tcf_inher of
+    Tcf_inherit of
       override_flag * class_expr * string option * (string * Ident.t) list *
         (string * Ident.t) list
     (* Inherited instance variables and concrete methods *)
-  | Tcf_val of
-      string * string loc * mutable_flag * Ident.t * class_field_kind * bool
-        (* None = virtual, true = override *)
-  | Tcf_meth of string * string loc * private_flag * class_field_kind * bool
-  | Tcf_constr of core_type * core_type
-(*  | Tcf_let of rec_flag * (pattern * expression) list *
-              (Ident.t * string loc * expression) list *)
-  | Tcf_init of expression
+  | Tcf_val of string loc * mutable_flag * Ident.t * class_field_kind * bool
+  | Tcf_method of string loc * private_flag * class_field_kind
+  | Tcf_constraint of core_type * core_type
+  | Tcf_initializer of expression
 
 (* Value expressions for the module language *)
 
@@ -161,7 +175,9 @@ and module_expr =
   { mod_desc: module_expr_desc;
     mod_loc: Location.t;
     mod_type: Types.module_type;
-    mod_env: Env.t }
+    mod_env: Env.t;
+    mod_attributes: attributes;
+   }
 
 and module_type_constraint =
   Tmodtype_implicit
@@ -189,19 +205,35 @@ and structure_item =
   }
 
 and structure_item_desc =
-    Tstr_eval of expression
-  | Tstr_value of rec_flag * (pattern * expression) list
-  | Tstr_primitive of Ident.t * string loc * value_description
-  | Tstr_type of (Ident.t * string loc * type_declaration) list
-  | Tstr_exception of Ident.t * string loc * exception_declaration
-  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc
-  | Tstr_module of Ident.t * string loc * module_expr
-  | Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
-  | Tstr_modtype of Ident.t * string loc * module_type
-  | Tstr_open of override_flag * Path.t * Longident.t loc
+    Tstr_eval of expression * attributes
+  | Tstr_value of rec_flag * value_binding list
+  | Tstr_primitive of value_description
+  | Tstr_type of type_declaration list
+  | Tstr_exception of constructor_declaration
+  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc * attributes
+  | Tstr_module of module_binding
+  | Tstr_recmodule of module_binding list
+  | Tstr_modtype of module_type_declaration
+  | Tstr_open of override_flag * Path.t * Longident.t loc * attributes
   | Tstr_class of (class_declaration * string list * virtual_flag) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
-  | Tstr_include of module_expr * Types.signature
+  | Tstr_include of module_expr * Types.signature * attributes
+  | Tstr_attribute of attribute
+
+and module_binding =
+    {
+     mb_id: Ident.t;
+     mb_name: string loc;
+     mb_expr: module_expr;
+     mb_attributes: attributes;
+    }
+
+and value_binding =
+  {
+    vb_pat: pattern;
+    vb_expr: expression;
+    vb_attributes: attributes;
+  }
 
 and module_coercion =
     Tcoerce_none
@@ -213,7 +245,9 @@ and module_type =
   { mty_desc: module_type_desc;
     mty_type : Types.module_type;
     mty_env : Env.t;
-    mty_loc: Location.t }
+    mty_loc: Location.t;
+    mty_attributes: attributes;
+   }
 
 and module_type_desc =
     Tmty_ident of Path.t * Longident.t loc
@@ -234,20 +268,33 @@ and signature_item =
     sig_loc: Location.t }
 
 and signature_item_desc =
-    Tsig_value of Ident.t * string loc * value_description
-  | Tsig_type of (Ident.t * string loc * type_declaration) list
-  | Tsig_exception of Ident.t * string loc * exception_declaration
-  | Tsig_module of Ident.t * string loc * module_type
-  | Tsig_recmodule of (Ident.t * string loc * module_type) list
-  | Tsig_modtype of Ident.t * string loc * modtype_declaration
-  | Tsig_open of override_flag * Path.t * Longident.t loc
-  | Tsig_include of module_type * Types.signature
+    Tsig_value of value_description
+  | Tsig_type of type_declaration list
+  | Tsig_exception of constructor_declaration
+  | Tsig_module of module_declaration
+  | Tsig_recmodule of module_declaration list
+  | Tsig_modtype of module_type_declaration
+  | Tsig_open of override_flag * Path.t * Longident.t loc * attributes
+  | Tsig_include of module_type * Types.signature * attributes
   | Tsig_class of class_description list
   | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
+
+and module_declaration =
+    {
+     md_id: Ident.t;
+     md_name: string loc;
+     md_type: module_type;
+     md_attributes: attributes;
+    }
 
-and modtype_declaration =
-    Tmodtype_abstract
-  | Tmodtype_manifest of module_type
+and module_type_declaration =
+    {
+     mtd_id: Ident.t;
+     mtd_name: string loc;
+     mtd_type: module_type option;
+     mtd_attributes: attributes;
+    }
 
 and with_constraint =
     Twith_type of type_declaration
@@ -260,7 +307,9 @@ and core_type =
   { mutable ctyp_desc : core_type_desc;
     mutable ctyp_type : type_expr;
     ctyp_env : Env.t; (* BINANNOT ADDED *)
-    ctyp_loc : Location.t }
+    ctyp_loc : Location.t;
+    ctyp_attributes: attributes;
+   }
 
 and core_type_desc =
     Ttyp_any
@@ -268,10 +317,10 @@ and core_type_desc =
   | Ttyp_arrow of label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
-  | Ttyp_object of core_field_type list
-  | Ttyp_class of Path.t * Longident.t loc * core_type list * label list
+  | Ttyp_object of (string * core_type) list * closed_flag
+  | Ttyp_class of Path.t * Longident.t loc * core_type list
   | Ttyp_alias of core_type * string
-  | Ttyp_variant of row_field list * bool * label list option
+  | Ttyp_variant of row_field list * closed_flag * label list option
   | Ttyp_poly of string list * core_type
   | Ttyp_package of package_type
 
@@ -282,75 +331,90 @@ and package_type = {
   pack_txt : Longident.t loc;
 }
 
-and core_field_type =
-  { field_desc: core_field_desc;
-    field_loc: Location.t }
-
-and core_field_desc =
-    Tcfield of string * core_type
-  | Tcfield_var
-
 and row_field =
     Ttag of label * bool * core_type list
   | Tinherit of core_type
 
 and value_description =
-  { val_desc : core_type;
-    val_val : Types.value_description;
-    val_prim : string list;
-    val_loc : Location.t;
+  { val_id: Ident.t;
+    val_name: string loc;
+    val_desc: core_type;
+    val_val: Types.value_description;
+    val_prim: string list;
+    val_loc: Location.t;
+    val_attributes: attributes;
     }
 
 and type_declaration =
-  { typ_params: string loc option list;
-    typ_type : Types.type_declaration;
+  {
+    typ_id: Ident.t;
+    typ_name: string loc;
+    typ_params: (string loc option * variance) list;
+    typ_type: Types.type_declaration;
     typ_cstrs: (core_type * core_type * Location.t) list;
     typ_kind: type_kind;
     typ_private: private_flag;
     typ_manifest: core_type option;
-    typ_variance: (bool * bool) list;
-    typ_loc: Location.t }
+    typ_loc: Location.t;
+    typ_attributes: attributes;
+   }
 
 and type_kind =
     Ttype_abstract
-  | Ttype_variant of (Ident.t * string loc * core_type list * Location.t) list
-  | Ttype_record of
-      (Ident.t * string loc * mutable_flag * core_type * Location.t) list
+  | Ttype_variant of constructor_declaration list
+  | Ttype_record of label_declaration list
+
+and label_declaration =
+    {
+     ld_id: Ident.t;
+     ld_name: string loc;
+     ld_mutable: mutable_flag;
+     ld_type: core_type;
+     ld_loc: Location.t;
+     ld_attributes: attributes;
+    }
 
-and exception_declaration =
-  { exn_params : core_type list;
-    exn_exn : Types.exception_declaration;
-    exn_loc : Location.t }
+and constructor_declaration =
+    {
+     cd_id: Ident.t;
+     cd_name: string loc;
+     cd_args: core_type list;
+     cd_res: core_type option;
+     cd_loc: Location.t;
+     cd_attributes: attributes;
+    }
 
 and class_type =
-  { cltyp_desc: class_type_desc;
-    cltyp_type : Types.class_type;
-    cltyp_env : Env.t; (* BINANNOT ADDED *)
-    cltyp_loc: Location.t }
+    {
+     cltyp_desc: class_type_desc;
+     cltyp_type: Types.class_type;
+     cltyp_env: Env.t;
+     cltyp_loc: Location.t;
+     cltyp_attributes: attributes;
+    }
 
 and class_type_desc =
     Tcty_constr of Path.t * Longident.t loc * core_type list
   | Tcty_signature of class_signature
-  | Tcty_fun of label * core_type * class_type
+  | Tcty_arrow of label * core_type * class_type
 
 and class_signature = {
     csig_self : core_type;
     csig_fields : class_type_field list;
     csig_type : Types.class_signature;
-    csig_loc : Location.t;
   }
 
 and class_type_field = {
-    ctf_desc : class_type_field_desc;
-    ctf_loc : Location.t;
+    ctf_desc: class_type_field_desc;
+    ctf_loc: Location.t;
+    ctf_attributes: attributes;
   }
 
 and class_type_field_desc =
-    Tctf_inher of class_type
+  | Tctf_inherit of class_type
   | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
-  | Tctf_virt  of (string * private_flag * core_type)
-  | Tctf_meth  of (string * private_flag * core_type)
-  | Tctf_cstr  of (core_type * core_type)
+  | Tctf_method of (string * private_flag * virtual_flag * core_type)
+  | Tctf_constraint of (core_type * core_type)
 
 and class_declaration =
   class_expr class_infos
@@ -363,7 +427,7 @@ and class_type_declaration =
 
 and 'a class_infos =
   { ci_virt: virtual_flag;
-    ci_params: string loc list * Location.t;
+    ci_params: (string loc * variance) list;
     ci_id_name : string loc;
     ci_id_class: Ident.t;
     ci_id_class_type : Ident.t;
@@ -372,21 +436,20 @@ and 'a class_infos =
     ci_expr: 'a;
     ci_decl: Types.class_declaration;
     ci_type_decl : Types.class_type_declaration;
-    ci_variance: (bool * bool) list;
-    ci_loc: Location.t }
+    ci_loc: Location.t;
+    ci_attributes: attributes;
+   }
 
 (* Auxiliary functions over the a.s.t. *)
 
 val iter_pattern_desc: (pattern -> unit) -> pattern_desc -> unit
 val map_pattern_desc: (pattern -> pattern) -> pattern_desc -> pattern_desc
 
-val let_bound_idents: (pattern * expression) list -> Ident.t list
-val rev_let_bound_idents: (pattern * expression) list -> Ident.t list
+val let_bound_idents: value_binding list -> Ident.t list
+val rev_let_bound_idents: value_binding list -> Ident.t list
 
 val let_bound_idents_with_loc:
-    (pattern * expression) list -> (Ident.t * string loc) list
-val rev_let_bound_idents_with_loc:
-    (pattern * expression) list -> (Ident.t * string loc) list
+    value_binding list -> (Ident.t * string loc) list
 
 (* Alpha conversion of patterns *)
 val alpha_pat: (Ident.t * Ident.t) list -> pattern -> pattern
diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml
index 42808266a..edb558798 100644
--- a/typing/typedtreeIter.ml
+++ b/typing/typedtreeIter.ml
@@ -24,14 +24,12 @@ module type IteratorArgument = sig
     val enter_structure : structure -> unit
     val enter_value_description : value_description -> unit
     val enter_type_declaration : type_declaration -> unit
-    val enter_exception_declaration :
-      exception_declaration -> unit
     val enter_pattern : pattern -> unit
     val enter_expression : expression -> unit
     val enter_package_type : package_type -> unit
     val enter_signature : signature -> unit
     val enter_signature_item : signature_item -> unit
-    val enter_modtype_declaration : modtype_declaration -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
     val enter_module_type : module_type -> unit
     val enter_module_expr : module_expr -> unit
     val enter_with_constraint : with_constraint -> unit
@@ -43,7 +41,6 @@ module type IteratorArgument = sig
     val enter_class_type : class_type -> unit
     val enter_class_type_field : class_type_field -> unit
     val enter_core_type : core_type -> unit
-    val enter_core_field_type : core_field_type -> unit
     val enter_class_structure : class_structure -> unit
     val enter_class_field : class_field -> unit
     val enter_structure_item : structure_item -> unit
@@ -52,14 +49,12 @@ module type IteratorArgument = sig
     val leave_structure : structure -> unit
     val leave_value_description : value_description -> unit
     val leave_type_declaration : type_declaration -> unit
-    val leave_exception_declaration :
-      exception_declaration -> unit
     val leave_pattern : pattern -> unit
     val leave_expression : expression -> unit
     val leave_package_type : package_type -> unit
     val leave_signature : signature -> unit
     val leave_signature_item : signature_item -> unit
-    val leave_modtype_declaration : modtype_declaration -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
     val leave_module_type : module_type -> unit
     val leave_module_expr : module_expr -> unit
     val leave_with_constraint : with_constraint -> unit
@@ -71,14 +66,13 @@ module type IteratorArgument = sig
     val leave_class_type : class_type -> unit
     val leave_class_type_field : class_type_field -> unit
     val leave_core_type : core_type -> unit
-    val leave_core_field_type : core_field_type -> unit
     val leave_class_structure : class_structure -> unit
     val leave_class_field : class_field -> unit
     val leave_structure_item : structure_item -> unit
 
     val enter_bindings : rec_flag -> unit
-    val enter_binding : pattern -> expression -> unit
-    val leave_binding : pattern -> expression -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
     val leave_bindings : rec_flag -> unit
 
       end
@@ -102,45 +96,45 @@ module MakeIterator(Iter : IteratorArgument) : sig
       | Some x -> f x
 
 
-    open Asttypes
-
     let rec iter_structure str =
       Iter.enter_structure str;
       List.iter iter_structure_item str.str_items;
       Iter.leave_structure str
 
 
-    and iter_binding (pat, exp) =
-      Iter.enter_binding pat exp;
-      iter_pattern pat;
-      iter_expression exp;
-      Iter.leave_binding pat exp
+    and iter_binding vb =
+      Iter.enter_binding vb;
+      iter_pattern vb.vb_pat;
+      iter_expression vb.vb_expr;
+      Iter.leave_binding vb
 
     and iter_bindings rec_flag list =
       Iter.enter_bindings rec_flag;
       List.iter iter_binding list;
       Iter.leave_bindings rec_flag
 
+    and iter_case {c_lhs; c_guard; c_rhs} =
+      iter_pattern c_lhs;
+      may_iter iter_expression c_guard;
+      iter_expression c_rhs
+
+    and iter_cases cases =
+      List.iter iter_case cases
+
     and iter_structure_item item =
       Iter.enter_structure_item item;
       begin
         match item.str_desc with
-          Tstr_eval exp -> iter_expression exp
+          Tstr_eval (exp, _attrs) -> iter_expression exp
         | Tstr_value (rec_flag, list) ->
             iter_bindings rec_flag list
-        | Tstr_primitive (id, _, v) -> iter_value_description v
-        | Tstr_type list ->
-            List.iter (fun (id, _, decl) -> iter_type_declaration decl) list
-        | Tstr_exception (id, _, decl) -> iter_exception_declaration decl
-        | Tstr_exn_rebind (id, _, p, _) -> ()
-        | Tstr_module (id, _, mexpr) ->
-            iter_module_expr mexpr
-        | Tstr_recmodule list ->
-            List.iter (fun (id, _, mtype, mexpr) ->
-                iter_module_type mtype;
-                iter_module_expr mexpr) list
-        | Tstr_modtype (id, _, mtype) ->
-            iter_module_type mtype
+        | Tstr_primitive vd -> iter_value_description vd
+        | Tstr_type list -> List.iter iter_type_declaration list
+        | Tstr_exception cd -> iter_constructor_declaration cd
+        | Tstr_exn_rebind _ -> ()
+        | Tstr_module x -> iter_module_binding x
+        | Tstr_recmodule list -> List.iter iter_module_binding list
+        | Tstr_modtype mtd -> iter_module_type_declaration mtd
         | Tstr_open _ -> ()
         | Tstr_class list ->
             List.iter (fun (ci, _, _) ->
@@ -154,16 +148,25 @@ module MakeIterator(Iter : IteratorArgument) : sig
                 iter_class_type ct.ci_expr;
                 Iter.leave_class_type_declaration ct;
             ) list
-        | Tstr_include (mexpr, _) ->
+        | Tstr_include (mexpr, _, _attrs) ->
             iter_module_expr mexpr
+        | Tstr_attribute _ ->
+            ()
       end;
       Iter.leave_structure_item item
 
+    and iter_module_binding x =
+      iter_module_expr x.mb_expr
+
     and iter_value_description v =
       Iter.enter_value_description v;
       iter_core_type v.val_desc;
       Iter.leave_value_description v
 
+    and iter_constructor_declaration cd =
+      List.iter iter_core_type cd.cd_args;
+      option iter_core_type cd.cd_res;
+
     and iter_type_declaration decl =
       Iter.enter_type_declaration decl;
       List.iter (fun (ct1, ct2, loc) ->
@@ -173,12 +176,11 @@ module MakeIterator(Iter : IteratorArgument) : sig
       begin match decl.typ_kind with
           Ttype_abstract -> ()
         | Ttype_variant list ->
-            List.iter (fun (s, _, cts, loc) ->
-                List.iter iter_core_type cts
-            ) list
+            List.iter iter_constructor_declaration list
         | Ttype_record list ->
-            List.iter (fun (s, _, mut, ct, loc) ->
-                iter_core_type ct
+            List.iter
+              (fun ld ->
+                iter_core_type ld.ld_type
             ) list
       end;
       begin match decl.typ_manifest with
@@ -187,14 +189,9 @@ module MakeIterator(Iter : IteratorArgument) : sig
       end;
       Iter.leave_type_declaration decl
 
-    and iter_exception_declaration decl =
-      Iter.enter_exception_declaration decl;
-      List.iter iter_core_type decl.exn_params;
-      Iter.leave_exception_declaration decl;
-
     and iter_pattern pat =
       Iter.enter_pattern pat;
-      List.iter (fun (cstr, _) -> match cstr with
+      List.iter (fun (cstr, _, _attrs) -> match cstr with
               | Tpat_type _ -> ()
               | Tpat_unpack -> ()
               | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
@@ -206,7 +203,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Tpat_constant cst -> ()
         | Tpat_tuple list ->
             List.iter iter_pattern list
-        | Tpat_construct (_, _, args, _) ->
+        | Tpat_construct (_, _, args) ->
             List.iter iter_pattern args
         | Tpat_variant (label, pato, _) ->
             begin match pato with
@@ -225,10 +222,12 @@ module MakeIterator(Iter : IteratorArgument) : sig
 
     and iter_expression exp =
       Iter.enter_expression exp;
-      List.iter (function (cstr, _) ->
+      List.iter (function (cstr, _, _attrs) ->
         match cstr with
-          Texp_constraint (cty1, cty2) ->
-            option iter_core_type cty1; option iter_core_type cty2
+          Texp_constraint ct ->
+            iter_core_type ct
+        | Texp_coerce (cty1, cty2) ->
+            option iter_core_type cty1; iter_core_type cty2
         | Texp_open (_, path, _, _) -> ()
         | Texp_poly cto -> option iter_core_type cto
         | Texp_newtype s -> ())
@@ -241,7 +240,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_bindings rec_flag list;
             iter_expression exp
         | Texp_function (label, cases, _) ->
-            iter_bindings Nonrecursive cases
+            iter_cases cases
         | Texp_apply (exp, list) ->
             iter_expression exp;
             List.iter (fun (label, expo, _) ->
@@ -251,13 +250,13 @@ module MakeIterator(Iter : IteratorArgument) : sig
             ) list
         | Texp_match (exp, list, _) ->
             iter_expression exp;
-            iter_bindings Nonrecursive list
+            iter_cases list
         | Texp_try (exp, list) ->
             iter_expression exp;
-            iter_bindings Nonrecursive list
+            iter_cases list
         | Texp_tuple list ->
             List.iter iter_expression list
-        | Texp_construct (_, _, args, _) ->
+        | Texp_construct (_, _, args) ->
             List.iter iter_expression args
         | Texp_variant (label, expo) ->
             begin match expo with
@@ -294,9 +293,6 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_expression exp1;
             iter_expression exp2;
             iter_expression exp3
-        | Texp_when (exp1, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
         | Texp_send (exp, meth, expo) ->
             iter_expression exp;
           begin
@@ -316,7 +312,6 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_module_expr mexpr;
             iter_expression exp
         | Texp_assert exp -> iter_expression exp
-        | Texp_assertfalse -> ()
         | Texp_lazy exp -> iter_expression exp
         | Texp_object (cl, _) ->
             iter_class_structure cl
@@ -339,37 +334,36 @@ module MakeIterator(Iter : IteratorArgument) : sig
       Iter.enter_signature_item item;
       begin
         match item.sig_desc with
-          Tsig_value (id, _, v) ->
-            iter_value_description v
+          Tsig_value vd ->
+            iter_value_description vd
         | Tsig_type list ->
-            List.iter (fun (id, _, decl) ->
-                iter_type_declaration decl
-            ) list
-        | Tsig_exception (id, _, decl) ->
-            iter_exception_declaration decl
-        | Tsig_module (id, _, mtype) ->
-            iter_module_type mtype
+            List.iter iter_type_declaration list
+        | Tsig_exception cd ->
+            iter_constructor_declaration cd
+        | Tsig_module md ->
+            iter_module_type md.md_type
         | Tsig_recmodule list ->
-            List.iter (fun (id, _, mtype) -> iter_module_type mtype) list
-        | Tsig_modtype (id, _, mdecl) ->
-            iter_modtype_declaration mdecl
+            List.iter (fun md -> iter_module_type md.md_type) list
+        | Tsig_modtype mtd ->
+            iter_module_type_declaration mtd
         | Tsig_open _ -> ()
-        | Tsig_include (mty,_) -> iter_module_type mty
+        | Tsig_include (mty, _, _attrs) -> iter_module_type mty
         | Tsig_class list ->
             List.iter iter_class_description list
         | Tsig_class_type list ->
             List.iter iter_class_type_declaration list
+        | Tsig_attribute _ -> ()
       end;
       Iter.leave_signature_item item;
 
-    and iter_modtype_declaration mdecl =
-      Iter.enter_modtype_declaration mdecl;
+    and iter_module_type_declaration mtd =
+      Iter.enter_module_type_declaration mtd;
       begin
-        match mdecl with
-          Tmodtype_abstract -> ()
-        | Tmodtype_manifest mtype -> iter_module_type mtype
+        match mtd.mtd_type with
+        | None -> ()
+        | Some mtype -> iter_module_type mtype
       end;
-      Iter.leave_modtype_declaration mdecl;
+      Iter.leave_module_type_declaration mtd
 
 
     and iter_class_description cd =
@@ -475,7 +469,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
           Tcty_signature csg -> iter_class_signature csg
         | Tcty_constr (path, _, list) ->
             List.iter iter_core_type list
-        | Tcty_fun (label, ct, cl) ->
+        | Tcty_arrow (label, ct, cl) ->
             iter_core_type ct;
             iter_class_type cl
       end;
@@ -492,14 +486,12 @@ module MakeIterator(Iter : IteratorArgument) : sig
       Iter.enter_class_type_field ctf;
       begin
         match ctf.ctf_desc with
-          Tctf_inher ct -> iter_class_type ct
-        | Tctf_val (s, mut, virt, ct) ->
+          Tctf_inherit ct -> iter_class_type ct
+        | Tctf_val (s, _mut, _virt, ct) ->
             iter_core_type ct
-        | Tctf_virt  (s, priv, ct) ->
+        | Tctf_method (s, _priv, _virt, ct) ->
             iter_core_type ct
-        | Tctf_meth  (s, priv, ct) ->
-            iter_core_type ct
-        | Tctf_cstr  (ct1, ct2) ->
+        | Tctf_constraint  (ct1, ct2) ->
             iter_core_type ct1;
             iter_core_type ct2
       end;
@@ -517,9 +509,9 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Ttyp_tuple list -> List.iter iter_core_type list
         | Ttyp_constr (path, _, list) ->
             List.iter iter_core_type list
-        | Ttyp_object list ->
-            List.iter iter_core_field_type list
-        | Ttyp_class (path, _, list, labels) ->
+        | Ttyp_object (list, o) ->
+            List.iter (fun (_, t) -> iter_core_type t) list
+        | Ttyp_class (path, _, list) ->
             List.iter iter_core_type list
         | Ttyp_alias (ct, s) ->
             iter_core_type ct
@@ -528,19 +520,11 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Ttyp_poly (list, ct) -> iter_core_type ct
         | Ttyp_package pack -> iter_package_type pack
       end;
-      Iter.leave_core_type ct;
-
-    and iter_core_field_type cft =
-      Iter.enter_core_field_type cft;
-      begin match cft.field_desc with
-          Tcfield_var -> ()
-        | Tcfield (s, ct) -> iter_core_type ct
-      end;
-      Iter.leave_core_field_type cft;
+      Iter.leave_core_type ct
 
     and iter_class_structure cs =
       Iter.enter_class_structure cs;
-      iter_pattern cs.cstr_pat;
+      iter_pattern cs.cstr_self;
       List.iter iter_class_field cs.cstr_fields;
       Iter.leave_class_structure cs;
 
@@ -555,27 +539,23 @@ module MakeIterator(Iter : IteratorArgument) : sig
       Iter.enter_class_field cf;
       begin
         match cf.cf_desc with
-          Tcf_inher (ovf, cl, super, _vals, _meths) ->
+          Tcf_inherit (ovf, cl, super, _vals, _meths) ->
           iter_class_expr cl
-      | Tcf_constr (cty, cty') ->
+      | Tcf_constraint (cty, cty') ->
           iter_core_type cty;
           iter_core_type cty'
-      | Tcf_val (lab, _, _, mut, Tcfk_virtual cty, override) ->
+      | Tcf_val (lab, _, _, Tcfk_virtual cty, _) ->
           iter_core_type cty
-      | Tcf_val (lab, _, _, mut, Tcfk_concrete exp, override) ->
+      | Tcf_val (lab, _, _, Tcfk_concrete (_, exp), _) ->
           iter_expression exp
-      | Tcf_meth (lab, _, priv, Tcfk_virtual cty, override) ->
+      | Tcf_method (lab, _, Tcfk_virtual cty) ->
           iter_core_type cty
-      | Tcf_meth (lab, _, priv, Tcfk_concrete exp, override) ->
+      | Tcf_method (lab, _, Tcfk_concrete (_, exp)) ->
           iter_expression exp
-(*      | Tcf_let (rec_flag, bindings, exps) ->
-          iter_bindings rec_flag bindings;
-        List.iter (fun (id, _, exp) -> iter_expression exp) exps; *)
-      | Tcf_init exp ->
+      | Tcf_initializer exp ->
           iter_expression exp
       end;
       Iter.leave_class_field cf;
-
   end
 
 module DefaultIteratorArgument = struct
@@ -589,7 +569,7 @@ module DefaultIteratorArgument = struct
       let enter_package_type _ = ()
       let enter_signature _ = ()
       let enter_signature_item _ = ()
-      let enter_modtype_declaration _ = ()
+      let enter_module_type_declaration _ = ()
       let enter_module_type _ = ()
       let enter_module_expr _ = ()
       let enter_with_constraint _ = ()
@@ -616,7 +596,7 @@ module DefaultIteratorArgument = struct
       let leave_package_type _ = ()
       let leave_signature _ = ()
       let leave_signature_item _ = ()
-      let leave_modtype_declaration _ = ()
+      let leave_module_type_declaration _ = ()
       let leave_module_type _ = ()
       let leave_module_expr _ = ()
       let leave_with_constraint _ = ()
@@ -633,8 +613,8 @@ module DefaultIteratorArgument = struct
     let leave_class_field _ = ()
     let leave_structure_item _ = ()
 
-    let enter_binding _ _ = ()
-    let leave_binding _ _ = ()
+    let enter_binding _ = ()
+    let leave_binding _ = ()
 
     let enter_bindings _ = ()
     let leave_bindings _ = ()
diff --git a/typing/typedtreeIter.mli b/typing/typedtreeIter.mli
index be9c6effb..158292980 100644
--- a/typing/typedtreeIter.mli
+++ b/typing/typedtreeIter.mli
@@ -18,14 +18,12 @@ module type IteratorArgument = sig
     val enter_structure : structure -> unit
     val enter_value_description : value_description -> unit
     val enter_type_declaration : type_declaration -> unit
-    val enter_exception_declaration :
-      exception_declaration -> unit
     val enter_pattern : pattern -> unit
     val enter_expression : expression -> unit
     val enter_package_type : package_type -> unit
     val enter_signature : signature -> unit
     val enter_signature_item : signature_item -> unit
-    val enter_modtype_declaration : modtype_declaration -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
     val enter_module_type : module_type -> unit
     val enter_module_expr : module_expr -> unit
     val enter_with_constraint : with_constraint -> unit
@@ -37,23 +35,20 @@ module type IteratorArgument = sig
     val enter_class_type : class_type -> unit
     val enter_class_type_field : class_type_field -> unit
     val enter_core_type : core_type -> unit
-    val enter_core_field_type : core_field_type -> unit
     val enter_class_structure : class_structure -> unit
     val enter_class_field : class_field -> unit
     val enter_structure_item : structure_item -> unit
 
 
-      val leave_structure : structure -> unit
+    val leave_structure : structure -> unit
     val leave_value_description : value_description -> unit
     val leave_type_declaration : type_declaration -> unit
-    val leave_exception_declaration :
-      exception_declaration -> unit
     val leave_pattern : pattern -> unit
     val leave_expression : expression -> unit
     val leave_package_type : package_type -> unit
     val leave_signature : signature -> unit
     val leave_signature_item : signature_item -> unit
-    val leave_modtype_declaration : modtype_declaration -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
     val leave_module_type : module_type -> unit
     val leave_module_expr : module_expr -> unit
     val leave_with_constraint : with_constraint -> unit
@@ -65,14 +60,13 @@ module type IteratorArgument = sig
     val leave_class_type : class_type -> unit
     val leave_class_type_field : class_type_field -> unit
     val leave_core_type : core_type -> unit
-    val leave_core_field_type : core_field_type -> unit
     val leave_class_structure : class_structure -> unit
     val leave_class_field : class_field -> unit
     val leave_structure_item : structure_item -> unit
 
     val enter_bindings : rec_flag -> unit
-    val enter_binding : pattern -> expression -> unit
-    val leave_binding : pattern -> expression -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
     val leave_bindings : rec_flag -> unit
 
       end
diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml
index 7c8c633d3..5c9229950 100644
--- a/typing/typedtreeMap.ml
+++ b/typing/typedtreeMap.ml
@@ -16,14 +16,12 @@ module type MapArgument = sig
   val enter_structure : structure -> structure
   val enter_value_description : value_description -> value_description
   val enter_type_declaration : type_declaration -> type_declaration
-  val enter_exception_declaration :
-    exception_declaration -> exception_declaration
   val enter_pattern : pattern -> pattern
   val enter_expression : expression -> expression
   val enter_package_type : package_type -> package_type
   val enter_signature : signature -> signature
   val enter_signature_item : signature_item -> signature_item
-  val enter_modtype_declaration : modtype_declaration -> modtype_declaration
+  val enter_module_type_declaration : module_type_declaration -> module_type_declaration
   val enter_module_type : module_type -> module_type
   val enter_module_expr : module_expr -> module_expr
   val enter_with_constraint : with_constraint -> with_constraint
@@ -36,7 +34,6 @@ module type MapArgument = sig
   val enter_class_type : class_type -> class_type
   val enter_class_type_field : class_type_field -> class_type_field
   val enter_core_type : core_type -> core_type
-  val enter_core_field_type : core_field_type -> core_field_type
   val enter_class_structure : class_structure -> class_structure
   val enter_class_field : class_field -> class_field
   val enter_structure_item : structure_item -> structure_item
@@ -44,14 +41,12 @@ module type MapArgument = sig
   val leave_structure : structure -> structure
   val leave_value_description : value_description -> value_description
   val leave_type_declaration : type_declaration -> type_declaration
-  val leave_exception_declaration :
-    exception_declaration -> exception_declaration
   val leave_pattern : pattern -> pattern
   val leave_expression : expression -> expression
   val leave_package_type : package_type -> package_type
   val leave_signature : signature -> signature
   val leave_signature_item : signature_item -> signature_item
-  val leave_modtype_declaration : modtype_declaration -> modtype_declaration
+  val leave_module_type_declaration : module_type_declaration -> module_type_declaration
   val leave_module_type : module_type -> module_type
   val leave_module_expr : module_expr -> module_expr
   val leave_with_constraint : with_constraint -> with_constraint
@@ -64,7 +59,6 @@ module type MapArgument = sig
   val leave_class_type : class_type -> class_type
   val leave_class_type_field : class_type_field -> class_type_field
   val leave_core_type : core_type -> core_type
-  val leave_core_field_type : core_field_type -> core_field_type
   val leave_class_structure : class_structure -> class_structure
   val leave_class_field : class_field -> class_field
   val leave_structure_item : structure_item -> structure_item
@@ -81,47 +75,55 @@ module MakeMap(Map : MapArgument) = struct
 
 
   open Misc
-  open Asttypes
 
   let rec map_structure str =
     let str = Map.enter_structure str in
     let str_items = List.map map_structure_item str.str_items in
     Map.leave_structure { str with str_items = str_items }
 
-  and map_binding (pat, exp) = (map_pattern pat, map_expression exp)
+  and map_binding vb =
+    {
+      vb_pat = map_pattern vb.vb_pat;
+      vb_expr = map_expression vb.vb_expr;
+      vb_attributes = vb.vb_attributes;
+    }
 
   and map_bindings rec_flag list =
     List.map map_binding list
 
+  and map_case {c_lhs; c_guard; c_rhs} =
+    {
+     c_lhs = map_pattern c_lhs;
+     c_guard = may_map map_expression c_guard;
+     c_rhs = map_expression c_rhs;
+    }
+
+  and map_cases list =
+    List.map map_case list
+
   and map_structure_item item =
     let item = Map.enter_structure_item item in
     let str_desc =
       match item.str_desc with
-          Tstr_eval exp -> Tstr_eval (map_expression exp)
+          Tstr_eval (exp, attrs) -> Tstr_eval (map_expression exp, attrs)
         | Tstr_value (rec_flag, list) ->
           Tstr_value (rec_flag, map_bindings rec_flag list)
-        | Tstr_primitive (id, name, v) ->
-          Tstr_primitive (id, name, map_value_description v)
+        | Tstr_primitive vd ->
+          Tstr_primitive (map_value_description vd)
         | Tstr_type list ->
-          Tstr_type (List.map (
-            fun (id, name, decl) ->
-              (id, name, map_type_declaration decl) ) list)
-        | Tstr_exception (id, name, decl) ->
-          Tstr_exception (id, name, map_exception_declaration decl)
-        | Tstr_exn_rebind (id, name, path, lid) ->
-          Tstr_exn_rebind (id, name, path, lid)
-        | Tstr_module (id, name, mexpr) ->
-          Tstr_module (id, name, map_module_expr mexpr)
+          Tstr_type (List.map map_type_declaration list)
+        | Tstr_exception cd ->
+          Tstr_exception (map_constructor_declaration cd)
+        | Tstr_exn_rebind (id, name, path, lid, attrs) ->
+          Tstr_exn_rebind (id, name, path, lid, attrs)
+        | Tstr_module x ->
+          Tstr_module (map_module_binding x)
         | Tstr_recmodule list ->
-          let list =
-            List.map (fun (id, name, mtype, mexpr) ->
-              (id, name, map_module_type mtype, map_module_expr mexpr)
-            ) list
-          in
+          let list = List.map map_module_binding list in
           Tstr_recmodule list
-        | Tstr_modtype (id, name, mtype) ->
-          Tstr_modtype (id, name, map_module_type mtype)
-        | Tstr_open (ovf, path, lid) -> Tstr_open (ovf, path, lid)
+        | Tstr_modtype mtd ->
+          Tstr_modtype (map_module_type_declaration mtd)
+        | Tstr_open (ovf, path, lid, attrs) -> Tstr_open (ovf, path, lid, attrs)
         | Tstr_class list ->
           let list =
             List.map (fun (ci, string_list, virtual_flag) ->
@@ -139,11 +141,15 @@ module MakeMap(Map : MapArgument) = struct
             (id, name, Map.leave_class_infos { ct with ci_expr = ci_expr})
           ) list in
           Tstr_class_type list
-        | Tstr_include (mexpr, sg) ->
-          Tstr_include (map_module_expr mexpr, sg)
+        | Tstr_include (mexpr, sg, attrs) ->
+          Tstr_include (map_module_expr mexpr, sg, attrs)
+        | Tstr_attribute x -> Tstr_attribute x
     in
     Map.leave_structure_item { item with str_desc = str_desc}
 
+  and map_module_binding x =
+    {x with mb_expr = map_module_expr x.mb_expr}
+
   and map_value_description v =
     let v = Map.enter_value_description v in
     let val_desc = map_core_type v.val_desc in
@@ -159,15 +165,15 @@ module MakeMap(Map : MapArgument) = struct
     let typ_kind = match decl.typ_kind with
         Ttype_abstract -> Ttype_abstract
       | Ttype_variant list ->
-        let list = List.map (fun (s, name, cts, loc) ->
-          (s, name, List.map map_core_type cts, loc)
-        ) list in
-        Ttype_variant list
+          let list = List.map map_constructor_declaration list in
+          Ttype_variant list
       | Ttype_record list ->
         let list =
-          List.map (fun (s, name, mut, ct, loc) ->
-            (s, name, mut, map_core_type ct, loc)
-          ) list in
+          List.map
+            (fun ld ->
+              {ld with ld_type = map_core_type ld.ld_type}
+            ) list
+        in
         Ttype_record list
     in
     let typ_manifest =
@@ -178,13 +184,10 @@ module MakeMap(Map : MapArgument) = struct
     Map.leave_type_declaration { decl with typ_cstrs = typ_cstrs;
       typ_kind = typ_kind; typ_manifest = typ_manifest }
 
-  and map_exception_declaration decl =
-    let decl = Map.enter_exception_declaration decl in
-    let exn_params = List.map map_core_type decl.exn_params in
-    let decl =       { exn_params = exn_params;
-                       exn_exn = decl.exn_exn;
-                       exn_loc = decl.exn_loc } in
-    Map.leave_exception_declaration decl;
+  and map_constructor_declaration cd =
+    {cd with cd_args = List.map map_core_type cd.cd_args;
+     cd_res = may_map map_core_type cd.cd_res
+    }
 
   and map_pattern pat =
     let pat = Map.enter_pattern pat in
@@ -194,9 +197,9 @@ module MakeMap(Map : MapArgument) = struct
           let pat1 = map_pattern pat1 in
           Tpat_alias (pat1, p, text)
         | Tpat_tuple list -> Tpat_tuple (List.map map_pattern list)
-        | Tpat_construct (lid, cstr_decl, args, arity) ->
+        | Tpat_construct (lid, cstr_decl, args) ->
           Tpat_construct (lid, cstr_decl,
-                          List.map map_pattern args, arity)
+                          List.map map_pattern args)
         | Tpat_variant (label, pato, rowo) ->
           let pato = match pato with
               None -> pato
@@ -220,8 +223,8 @@ module MakeMap(Map : MapArgument) = struct
 
   and map_pat_extra pat_extra =
     match pat_extra with
-      | Tpat_constraint ct, loc -> (Tpat_constraint (map_core_type  ct), loc)
-      | (Tpat_type _ | Tpat_unpack), _ -> pat_extra
+      | Tpat_constraint ct, loc, attrs -> (Tpat_constraint (map_core_type  ct), loc, attrs)
+      | (Tpat_type _ | Tpat_unpack), _, _ -> pat_extra
 
   and map_expression exp =
     let exp = Map.enter_expression exp in
@@ -234,7 +237,7 @@ module MakeMap(Map : MapArgument) = struct
                     map_bindings rec_flag list,
                     map_expression exp)
         | Texp_function (label, cases, partial) ->
-          Texp_function (label, map_bindings Nonrecursive cases, partial)
+          Texp_function (label, map_cases cases, partial)
         | Texp_apply (exp, list) ->
           Texp_apply (map_expression exp,
                       List.map (fun (label, expo, optional) ->
@@ -248,19 +251,19 @@ module MakeMap(Map : MapArgument) = struct
         | Texp_match (exp, list, partial) ->
           Texp_match (
             map_expression exp,
-            map_bindings Nonrecursive list,
+            map_cases list,
             partial
           )
         | Texp_try (exp, list) ->
           Texp_try (
             map_expression exp,
-            map_bindings Nonrecursive list
+            map_cases list
           )
         | Texp_tuple list ->
           Texp_tuple (List.map map_expression list)
-        | Texp_construct (lid, cstr_desc, args, arity) ->
+        | Texp_construct (lid, cstr_desc, args) ->
           Texp_construct (lid, cstr_desc,
-                          List.map map_expression args, arity )
+                          List.map map_expression args )
         | Texp_variant (label, expo) ->
           let expo =match expo with
               None -> expo
@@ -313,11 +316,6 @@ module MakeMap(Map : MapArgument) = struct
             dir,
             map_expression exp3
           )
-        | Texp_when (exp1, exp2) ->
-          Texp_when (
-            map_expression exp1,
-            map_expression exp2
-          )
         | Texp_send (exp, meth, expo) ->
           Texp_send (map_expression exp, meth, may_map map_expression expo)
         | Texp_new (path, lid, cl_decl) -> exp.exp_desc
@@ -338,7 +336,6 @@ module MakeMap(Map : MapArgument) = struct
             map_expression exp
           )
         | Texp_assert exp -> Texp_assert (map_expression exp)
-        | Texp_assertfalse -> exp.exp_desc
         | Texp_lazy exp -> Texp_lazy (map_expression exp)
         | Texp_object (cl, string_list) ->
           Texp_object (map_class_structure cl, string_list)
@@ -349,22 +346,20 @@ module MakeMap(Map : MapArgument) = struct
     Map.leave_expression {
       exp with
         exp_desc = exp_desc;
-        exp_extra = exp_extra }
-
-  and map_exp_extra exp_extra =
-    let loc = snd exp_extra in
-    match fst exp_extra with
-      | Texp_constraint (Some ct, None) ->
-        Texp_constraint (Some (map_core_type ct), None), loc
-      | Texp_constraint (None, Some ct) ->
-        Texp_constraint (None, Some (map_core_type ct)), loc
-      | Texp_constraint (Some ct1, Some ct2) ->
-        Texp_constraint (Some (map_core_type ct1),
-                         Some (map_core_type ct2)), loc
+        exp_extra = exp_extra; }
+
+  and map_exp_extra ((desc, loc, attrs) as exp_extra) =
+    match desc with
+      | Texp_constraint ct ->
+        Texp_constraint (map_core_type ct), loc, attrs
+      | Texp_coerce (None, ct) ->
+        Texp_coerce (None, map_core_type ct), loc, attrs
+      | Texp_coerce (Some ct1, ct2) ->
+        Texp_coerce (Some (map_core_type ct1),
+                         map_core_type ct2), loc, attrs
       | Texp_poly (Some ct) ->
-        Texp_poly (Some ( map_core_type ct )), loc
+        Texp_poly (Some ( map_core_type ct )), loc, attrs
       | Texp_newtype _
-      | Texp_constraint (None, None)
       | Texp_open _
       | Texp_poly None -> exp_extra
 
@@ -384,40 +379,34 @@ module MakeMap(Map : MapArgument) = struct
     let item = Map.enter_signature_item item in
     let sig_desc =
       match item.sig_desc with
-          Tsig_value (id, name, v) ->
-            Tsig_value (id, name, map_value_description v)
-        | Tsig_type list -> Tsig_type (
-          List.map (fun (id, name, decl) ->
-            (id, name, map_type_declaration decl)
-          ) list
-        )
-        | Tsig_exception (id, name, decl) ->
-          Tsig_exception (id, name, map_exception_declaration decl)
-        | Tsig_module (id, name, mtype) ->
-          Tsig_module (id, name, map_module_type mtype)
+          Tsig_value vd ->
+            Tsig_value (map_value_description vd)
+        | Tsig_type list -> Tsig_type (List.map map_type_declaration list)
+        | Tsig_exception cd ->
+          Tsig_exception (map_constructor_declaration cd)
+        | Tsig_module md ->
+          Tsig_module {md with md_type = map_module_type md.md_type}
         | Tsig_recmodule list ->
-          Tsig_recmodule (List.map (
-            fun (id, name, mtype) ->
-              (id, name, map_module_type mtype) ) list)
-        | Tsig_modtype (id, name, mdecl) ->
-          Tsig_modtype (id, name, map_modtype_declaration mdecl)
+          Tsig_recmodule
+              (List.map
+                 (fun md -> {md with md_type = map_module_type md.md_type})
+                 list
+              )
+        | Tsig_modtype mtd ->
+          Tsig_modtype (map_module_type_declaration mtd)
         | Tsig_open _ -> item.sig_desc
-        | Tsig_include (mty, sg) -> Tsig_include (map_module_type mty, sg)
+        | Tsig_include (mty, sg, attrs) -> Tsig_include (map_module_type mty, sg, attrs)
         | Tsig_class list -> Tsig_class (List.map map_class_description list)
         | Tsig_class_type list ->
           Tsig_class_type (List.map map_class_type_declaration list)
+        | Tsig_attribute _ as x -> x
     in
     Map.leave_signature_item { item with sig_desc = sig_desc }
 
-  and map_modtype_declaration mdecl =
-    let mdecl = Map.enter_modtype_declaration mdecl in
-    let mdecl =
-      match mdecl with
-          Tmodtype_abstract -> Tmodtype_abstract
-        | Tmodtype_manifest mtype ->
-          Tmodtype_manifest (map_module_type mtype)
-    in
-    Map.leave_modtype_declaration mdecl
+  and map_module_type_declaration mtd =
+    let mtd = Map.enter_module_type_declaration mtd in
+    let mtd = {mtd with mtd_type = may_map map_module_type mtd.mtd_type} in
+    Map.leave_module_type_declaration mtd
 
 
   and map_class_description cd =
@@ -526,8 +515,8 @@ module MakeMap(Map : MapArgument) = struct
           Tcty_signature csg -> Tcty_signature (map_class_signature csg)
         | Tcty_constr (path, lid, list) ->
           Tcty_constr (path, lid, List.map map_core_type list)
-        | Tcty_fun (label, ct, cl) ->
-          Tcty_fun (label, map_core_type ct, map_class_type cl)
+        | Tcty_arrow (label, ct, cl) ->
+          Tcty_arrow (label, map_core_type ct, map_class_type cl)
     in
     Map.leave_class_type { ct with cltyp_desc = cltyp_desc }
 
@@ -543,15 +532,13 @@ module MakeMap(Map : MapArgument) = struct
     let ctf = Map.enter_class_type_field ctf in
     let ctf_desc =
       match ctf.ctf_desc with
-          Tctf_inher ct -> Tctf_inher (map_class_type ct)
+          Tctf_inherit ct -> Tctf_inherit (map_class_type ct)
         | Tctf_val (s, mut, virt, ct) ->
           Tctf_val (s, mut, virt, map_core_type ct)
-        | Tctf_virt  (s, priv, ct) ->
-          Tctf_virt (s, priv, map_core_type ct)
-        | Tctf_meth  (s, priv, ct) ->
-          Tctf_meth (s, priv, map_core_type ct)
-        | Tctf_cstr  (ct1, ct2) ->
-          Tctf_cstr (map_core_type ct1, map_core_type ct2)
+        | Tctf_method (s, priv, virt, ct) ->
+          Tctf_method (s, priv, virt, map_core_type ct)
+        | Tctf_constraint (ct1, ct2) ->
+          Tctf_constraint (map_core_type ct1, map_core_type ct2)
     in
     Map.leave_class_type_field { ctf with ctf_desc = ctf_desc }
 
@@ -566,9 +553,10 @@ module MakeMap(Map : MapArgument) = struct
         | Ttyp_tuple list -> Ttyp_tuple (List.map map_core_type list)
         | Ttyp_constr (path, lid, list) ->
           Ttyp_constr (path, lid, List.map map_core_type list)
-        | Ttyp_object list -> Ttyp_object (List.map map_core_field_type list)
-        | Ttyp_class (path, lid, list, labels) ->
-          Ttyp_class (path, lid, List.map map_core_type list, labels)
+        | Ttyp_object (list, o) ->
+          Ttyp_object (List.map (fun (s, t) -> (s, map_core_type t)) list, o)
+        | Ttyp_class (path, lid, list) ->
+          Ttyp_class (path, lid, List.map map_core_type list)
         | Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
         | Ttyp_variant (list, bool, labels) ->
           Ttyp_variant (List.map map_row_field list, bool, labels)
@@ -577,20 +565,11 @@ module MakeMap(Map : MapArgument) = struct
     in
     Map.leave_core_type { ct with ctyp_desc = ctyp_desc }
 
-  and map_core_field_type cft =
-    let cft = Map.enter_core_field_type cft in
-    let field_desc = match cft.field_desc with
-        Tcfield_var -> Tcfield_var
-      | Tcfield (s, ct) -> Tcfield (s, map_core_type ct)
-    in
-    Map.leave_core_field_type { cft with field_desc = field_desc }
-
   and map_class_structure cs =
     let cs = Map.enter_class_structure cs in
-    let cstr_pat = map_pattern cs.cstr_pat in
+    let cstr_self = map_pattern cs.cstr_self in
     let cstr_fields = List.map map_class_field cs.cstr_fields in
-    Map.leave_class_structure { cs with cstr_pat = cstr_pat;
-      cstr_fields = cstr_fields }
+    Map.leave_class_structure { cs with cstr_self; cstr_fields }
 
   and map_row_field rf =
     match rf with
@@ -602,23 +581,19 @@ module MakeMap(Map : MapArgument) = struct
     let cf = Map.enter_class_field cf in
     let cf_desc =
       match cf.cf_desc with
-          Tcf_inher (ovf, cl, super, vals, meths) ->
-            Tcf_inher (ovf, map_class_expr cl, super, vals, meths)
-        | Tcf_constr (cty, cty') ->
-          Tcf_constr (map_core_type cty, map_core_type cty')
-        | Tcf_val (lab, name, mut, ident, Tcfk_virtual cty, override) ->
-          Tcf_val (lab, name, mut, ident, Tcfk_virtual (map_core_type cty),
-                   override)
-        | Tcf_val (lab, name, mut, ident, Tcfk_concrete exp, override) ->
-          Tcf_val (lab, name, mut, ident, Tcfk_concrete (map_expression exp),
-                   override)
-        | Tcf_meth (lab, name, priv, Tcfk_virtual cty, override) ->
-          Tcf_meth (lab, name, priv, Tcfk_virtual (map_core_type cty),
-                    override)
-        | Tcf_meth (lab, name, priv, Tcfk_concrete exp, override) ->
-          Tcf_meth (lab, name, priv, Tcfk_concrete (map_expression exp),
-                    override)
-        | Tcf_init exp -> Tcf_init (map_expression exp)
+          Tcf_inherit (ovf, cl, super, vals, meths) ->
+            Tcf_inherit (ovf, map_class_expr cl, super, vals, meths)
+        | Tcf_constraint (cty, cty') ->
+          Tcf_constraint (map_core_type cty, map_core_type cty')
+        | Tcf_val (lab, mut, ident, Tcfk_virtual cty, b) ->
+          Tcf_val (lab, mut, ident, Tcfk_virtual (map_core_type cty), b)
+        | Tcf_val (lab, mut, ident, Tcfk_concrete (o, exp), b) ->
+          Tcf_val (lab, mut, ident, Tcfk_concrete (o, map_expression exp), b)
+        | Tcf_method (lab, priv, Tcfk_virtual cty) ->
+          Tcf_method (lab, priv, Tcfk_virtual (map_core_type cty))
+        | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
+          Tcf_method (lab, priv, Tcfk_concrete (o, map_expression exp))
+        | Tcf_initializer exp -> Tcf_initializer (map_expression exp)
     in
     Map.leave_class_field { cf with cf_desc = cf_desc }
 end
@@ -635,7 +610,7 @@ module DefaultMapArgument = struct
   let enter_package_type t = t
   let enter_signature t = t
   let enter_signature_item t = t
-  let enter_modtype_declaration t = t
+  let enter_module_type_declaration t = t
   let enter_module_type t = t
   let enter_module_expr t = t
   let enter_with_constraint t = t
@@ -647,7 +622,6 @@ module DefaultMapArgument = struct
   let enter_class_type t = t
   let enter_class_type_field t = t
   let enter_core_type t = t
-  let enter_core_field_type t = t
   let enter_class_structure t = t
   let enter_class_field t = t
   let enter_structure_item t = t
@@ -662,7 +636,7 @@ module DefaultMapArgument = struct
   let leave_package_type t = t
   let leave_signature t = t
   let leave_signature_item t = t
-  let leave_modtype_declaration t = t
+  let leave_module_type_declaration t = t
   let leave_module_type t = t
   let leave_module_expr t = t
   let leave_with_constraint t = t
@@ -674,7 +648,6 @@ module DefaultMapArgument = struct
   let leave_class_type t = t
   let leave_class_type_field t = t
   let leave_core_type t = t
-  let leave_core_field_type t = t
   let leave_class_structure t = t
   let leave_class_field t = t
   let leave_structure_item t = t
diff --git a/typing/typedtreeMap.mli b/typing/typedtreeMap.mli
index 0248f023a..9ee2c8c4a 100644
--- a/typing/typedtreeMap.mli
+++ b/typing/typedtreeMap.mli
@@ -16,14 +16,12 @@ module type MapArgument = sig
   val enter_structure : structure -> structure
   val enter_value_description : value_description -> value_description
   val enter_type_declaration : type_declaration -> type_declaration
-  val enter_exception_declaration :
-    exception_declaration -> exception_declaration
   val enter_pattern : pattern -> pattern
   val enter_expression : expression -> expression
   val enter_package_type : package_type -> package_type
   val enter_signature : signature -> signature
   val enter_signature_item : signature_item -> signature_item
-  val enter_modtype_declaration : modtype_declaration -> modtype_declaration
+  val enter_module_type_declaration : module_type_declaration -> module_type_declaration
   val enter_module_type : module_type -> module_type
   val enter_module_expr : module_expr -> module_expr
   val enter_with_constraint : with_constraint -> with_constraint
@@ -36,7 +34,6 @@ module type MapArgument = sig
   val enter_class_type : class_type -> class_type
   val enter_class_type_field : class_type_field -> class_type_field
   val enter_core_type : core_type -> core_type
-  val enter_core_field_type : core_field_type -> core_field_type
   val enter_class_structure : class_structure -> class_structure
   val enter_class_field : class_field -> class_field
   val enter_structure_item : structure_item -> structure_item
@@ -44,14 +41,12 @@ module type MapArgument = sig
   val leave_structure : structure -> structure
   val leave_value_description : value_description -> value_description
   val leave_type_declaration : type_declaration -> type_declaration
-  val leave_exception_declaration :
-    exception_declaration -> exception_declaration
   val leave_pattern : pattern -> pattern
   val leave_expression : expression -> expression
   val leave_package_type : package_type -> package_type
   val leave_signature : signature -> signature
   val leave_signature_item : signature_item -> signature_item
-  val leave_modtype_declaration : modtype_declaration -> modtype_declaration
+  val leave_module_type_declaration : module_type_declaration -> module_type_declaration
   val leave_module_type : module_type -> module_type
   val leave_module_expr : module_expr -> module_expr
   val leave_with_constraint : with_constraint -> with_constraint
@@ -64,7 +59,6 @@ module type MapArgument = sig
   val leave_class_type : class_type -> class_type
   val leave_class_type_field : class_type_field -> class_type_field
   val leave_core_type : core_type -> core_type
-  val leave_core_field_type : core_field_type -> core_field_type
   val leave_class_structure : class_structure -> class_structure
   val leave_class_field : class_field -> class_field
   val leave_structure_item : structure_item -> structure_item
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 521b0787c..a4ea9499b 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -37,6 +37,8 @@ type error =
   | Not_a_packed_module of type_expr
   | Incomplete_packed_module of type_expr
   | Scoping_pack of Longident.t * type_expr
+  | Extension of string
+  | Recursive_module_require_explicit_type
 
 exception Error of Location.t * Env.t * error
 
@@ -99,8 +101,6 @@ let rec make_params n = function
     [] -> []
   | _ :: l -> ("a" ^ string_of_int n) :: make_params (n+1) l
 
-let wrap_param s = {ptyp_desc=Ptyp_var s; ptyp_loc=Location.none}
-
 let make_next_first rs rem =
   if rs = Trec_first then
     match rem with
@@ -119,14 +119,20 @@ let make p n i =
   let open Variance in
   set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
 
-let merge_constraint initial_env loc  sg lid constr =
+let merge_constraint initial_env loc sg constr =
+  let lid =
+    match constr with
+    | Pwith_type (lid, _) | Pwith_module (lid, _) -> lid
+    | Pwith_typesubst {ptype_name=s} | Pwith_modsubst (s, _) ->
+        {loc = s.loc; txt=Lident s.txt}
+  in
   let real_id = ref None in
   let rec merge env sg namelist row_id =
     match (sg, namelist, constr) with
       ([], _, _) ->
         raise(Error(loc, env, With_no_component lid.txt))
     | (Sig_type(id, decl, rs) :: rem, [s],
-       Pwith_type ({ptype_kind = Ptype_abstract} as sdecl))
+       Pwith_type (_, ({ptype_kind = Ptype_abstract} as sdecl)))
       when Ident.name id = s && Typedecl.is_fixed_type sdecl ->
         let decl_row =
           { type_params =
@@ -136,8 +142,17 @@ let merge_constraint initial_env loc  sg lid constr =
             type_private = Private;
             type_manifest = None;
             type_variance =
-              List.map (fun (c,n) -> make (not n) (not c) false)
-              sdecl.ptype_variance;
+              List.map
+                (fun (_, v) ->
+                   let (c, n) =  
+                     match v with
+                     | Covariant -> true, false
+                     | Contravariant -> false, true
+                     | Invariant -> false, false
+                   in
+                   make (not n) (not c) false
+                )
+                sdecl.ptype_params;
             type_loc = sdecl.ptype_loc;
             type_newtype_level = None }
         and id_row = Ident.create (s^"#row") in
@@ -150,7 +165,7 @@ let merge_constraint initial_env loc  sg lid constr =
         let rs' = if rs = Trec_first then Trec_not else rs in
         (Pident id, lid, Twith_type tdecl),
         Sig_type(id_row, decl_row, rs') :: Sig_type(id, newdecl, rs) :: rem
-    | (Sig_type(id, decl, rs) :: rem , [s], Pwith_type sdecl)
+    | (Sig_type(id, decl, rs) :: rem , [s], Pwith_type (_, sdecl))
       when Ident.name id = s ->
         let tdecl =
           Typedecl.transl_with_constraint initial_env id None decl sdecl in
@@ -170,14 +185,14 @@ let merge_constraint initial_env loc  sg lid constr =
         real_id := Some id;
         (Pident id, lid, Twith_typesubst tdecl),
         make_next_first rs rem
-    | (Sig_module(id, mty, rs) :: rem, [s], Pwith_module (lid))
+    | (Sig_module(id, mty, rs) :: rem, [s], Pwith_module (_, lid))
       when Ident.name id = s ->
         let (path, mty') = Typetexp.find_module initial_env loc lid.txt in
         let newmty = Mtype.strengthen env mty' path in
         ignore(Includemod.modtypes env newmty mty);
         (Pident id, lid, Twith_module (path, lid)),
         Sig_module(id, newmty, rs) :: rem
-    | (Sig_module(id, mty, rs) :: rem, [s], Pwith_modsubst (lid))
+    | (Sig_module(id, mty, rs) :: rem, [s], Pwith_modsubst (_, lid))
       when Ident.name id = s ->
         let (path, mty') = Typetexp.find_module initial_env loc lid.txt in
         let newmty = Mtype.strengthen env mty' path in
@@ -212,7 +227,7 @@ let merge_constraint initial_env loc  sg lid constr =
                 List.map
                   (function {ptyp_desc=Ptyp_var s} -> s | _ -> raise Exit)
                   stl in
-              List.iter2 (fun x ox ->
+              List.iter2 (fun x (ox, _) ->
                 match ox with
                     Some y when x = y.txt -> ()
                   | _ -> raise Exit
@@ -227,7 +242,7 @@ let merge_constraint initial_env loc  sg lid constr =
         in
         let sub = Subst.add_type id path Subst.identity in
         Subst.signature sub sg
-    | [s], Pwith_modsubst (lid) ->
+    | [s], Pwith_modsubst (_, lid) ->
         let id =
           match !real_id with None -> assert false | Some id -> id in
         let (path, _) = Typetexp.find_module initial_env loc lid.txt in
@@ -259,7 +274,7 @@ let rec map_rec' fn decls rem =
 
 let rec map_rec'' fn decls rem =
   match decls with
-  | (id, _,_ as d1) :: dl when Btype.is_row_name (Ident.name id) ->
+  | d1 :: dl when Btype.is_row_name (Ident.name d1.typ_id) ->
       fn Trec_not d1 :: map_rec'' fn dl rem
   | _ -> map_rec fn decls rem
 
@@ -286,6 +301,8 @@ let rec approx_modtype env smty =
   | Pmty_typeof smod ->
       let (_, mty) = !type_module_type_of_fwd env smod in
       mty
+  | Pmty_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
 
 and approx_sig env ssg =
   match ssg with
@@ -296,29 +313,29 @@ and approx_sig env ssg =
           let decls = Typedecl.approx_type_decl env sdecls in
           let rem = approx_sig env srem in
           map_rec' (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem
-      | Psig_module(name, smty) ->
-          let mty = approx_modtype env smty in
-          let (id, newenv) = Env.enter_module name.txt mty env in
+      | Psig_module pmd ->
+          let mty = approx_modtype env pmd.pmd_type in
+          let (id, newenv) = Env.enter_module pmd.pmd_name.txt mty env in
           Sig_module(id, mty, Trec_not) :: approx_sig newenv srem
       | Psig_recmodule sdecls ->
           let decls =
             List.map
-              (fun (name, smty) ->
-                (Ident.create name.txt, approx_modtype env smty))
+              (fun pmd ->
+                (Ident.create pmd.pmd_name.txt, approx_modtype env pmd.pmd_type))
               sdecls in
           let newenv =
             List.fold_left (fun env (id, mty) -> Env.add_module id mty env)
             env decls in
           map_rec (fun rs (id, mty) -> Sig_module(id, mty, rs)) decls
                   (approx_sig newenv srem)
-      | Psig_modtype(name, sinfo) ->
-          let info = approx_modtype_info env sinfo in
-          let (id, newenv) = Env.enter_modtype name.txt info env in
+      | Psig_modtype d ->
+          let info = approx_modtype_info env d.pmtd_type in
+          let (id, newenv) = Env.enter_modtype d.pmtd_name.txt info env in
           Sig_modtype(id, info) :: approx_sig newenv srem
-      | Psig_open (ovf, lid) ->
+      | Psig_open (ovf, lid, _attrs) ->
           let (path, mty) = type_open ovf env item.psig_loc lid in
           approx_sig mty srem
-      | Psig_include smty ->
+      | Psig_include (smty, _attrs) ->
           let mty = approx_modtype env smty in
           let sg = Subst.signature Subst.identity
                      (extract_sig env smty.pmty_loc mty) in
@@ -339,9 +356,9 @@ and approx_sig env ssg =
 
 and approx_modtype_info env sinfo =
   match sinfo with
-    Pmodtype_abstract ->
+    None ->
       Modtype_abstract
-  | Pmodtype_manifest smty ->
+  | Some smty ->
       Modtype_manifest(approx_modtype env smty)
 
 (* Additional validity checks on type definitions arising from
@@ -350,11 +367,11 @@ and approx_modtype_info env sinfo =
 let check_recmod_typedecls env sdecls decls =
   let recmod_ids = List.map fst3 decls in
   List.iter2
-    (fun (_, smty) (id, _, mty) ->
+    (fun pmd (id, _, mty) ->
        let mty = mty.mty_type in
       List.iter
         (fun path ->
-          Typedecl.check_recmod_typedecl env smty.pmty_loc recmod_ids
+          Typedecl.check_recmod_typedecl env pmd.pmd_type.pmty_loc recmod_ids
                                          path (Env.find_type path env))
         (Mtype.type_paths env (Pident id) mty))
     sdecls decls
@@ -403,12 +420,13 @@ let transl_modtype_longident loc env lid =
   let (path, info) = Typetexp.find_modtype env loc lid in
   path
 
-let mkmty desc typ env loc =
+let mkmty desc typ env loc attrs =
   let mty = {
     mty_desc = desc;
     mty_type = typ;
     mty_loc = loc;
     mty_env = env;
+    mty_attributes = attrs;
     } in
   Cmt_format.add_saved_type (Cmt_format.Partial_module_type mty);
   mty
@@ -426,31 +444,37 @@ let rec transl_modtype env smty =
     Pmty_ident lid ->
       let path = transl_modtype_longident loc env lid.txt in
       mkmty (Tmty_ident (path, lid)) (Mty_ident path) env loc
+        smty.pmty_attributes
   | Pmty_signature ssg ->
       let sg = transl_signature env ssg in
       mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
+        smty.pmty_attributes
   | Pmty_functor(param, sarg, sres) ->
       let arg = transl_modtype env sarg in
       let (id, newenv) = Env.enter_module param.txt arg.mty_type env in
       let res = transl_modtype newenv sres in
       mkmty (Tmty_functor (id, param, arg, res))
       (Mty_functor(id, arg.mty_type, res.mty_type)) env loc
+        smty.pmty_attributes
   | Pmty_with(sbody, constraints) ->
       let body = transl_modtype env sbody in
       let init_sg = extract_sig env sbody.pmty_loc body.mty_type in
       let (tcstrs, final_sg) =
         List.fold_left
-          (fun (tcstrs,sg) (lid, sdecl) ->
-            let (tcstr, sg) = merge_constraint env smty.pmty_loc sg lid sdecl
+          (fun (tcstrs,sg) sdecl ->
+            let (tcstr, sg) = merge_constraint env smty.pmty_loc sg sdecl
             in
             (tcstr :: tcstrs, sg)
         )
         ([],init_sg) constraints in
       mkmty (Tmty_with ( body, tcstrs))
-      (Mtype.freshen (Mty_signature final_sg)) env loc
+        (Mtype.freshen (Mty_signature final_sg)) env loc
+        smty.pmty_attributes
   | Pmty_typeof smod ->
       let tmty, mty = !type_module_type_of_fwd env smod in
-      mkmty (Tmty_typeof tmty) mty env loc
+      mkmty (Tmty_typeof tmty) mty env loc smty.pmty_attributes
+  | Pmty_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
 
 
 and transl_signature env sg =
@@ -464,71 +488,67 @@ and transl_signature env sg =
     | item :: srem ->
         let loc = item.psig_loc in
         match item.psig_desc with
-        | Psig_value(name, sdesc) ->
-            let tdesc = Typedecl.transl_value_decl env item.psig_loc sdesc in
-            let desc = tdesc.val_val in
-            let (id, newenv) =
-              Env.enter_value name.txt desc env
-                ~check:(fun s -> Warnings.Unused_value_declaration s)  in
+        | Psig_value sdesc ->
+            let (tdesc, newenv) = Typedecl.transl_value_decl env item.psig_loc sdesc in
             let (trem,rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_value (id, name, tdesc)) env loc :: trem,
-            (if List.exists (Ident.equal id) (get_values rem) then rem
-            else Sig_value(id, desc) :: rem),
+            mksig (Tsig_value tdesc) env loc :: trem,
+            (if List.exists (Ident.equal tdesc.val_id) (get_values rem) then rem
+            else Sig_value(tdesc.val_id, tdesc.val_val) :: rem),
               final_env
         | Psig_type sdecls ->
             List.iter
-              (fun (name, decl) ->
-                check "type" item.psig_loc type_names name.txt)
+              (fun decl ->
+                check "type" item.psig_loc type_names decl.ptype_name.txt)
               sdecls;
             let (decls, newenv) = Typedecl.transl_type_decl env sdecls in
             let (trem, rem, final_env) = transl_sig newenv srem in
             mksig (Tsig_type decls) env loc :: trem,
-            map_rec'' (fun rs (id, _, info) ->
-                Sig_type(id, info.typ_type, rs)) decls rem,
+            map_rec'' (fun rs td ->
+                Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
             final_env
-        | Psig_exception(name, sarg) ->
-            let arg = Typedecl.transl_exception env item.psig_loc sarg in
-            let (id, newenv) = Env.enter_exception name.txt arg.exn_exn env in
+        | Psig_exception sarg ->
+            let (arg, decl, newenv) = Typedecl.transl_exception env sarg in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_exception (id, name, arg)) env loc :: trem,
+            let id = arg.cd_id in
+            mksig (Tsig_exception arg) env loc :: trem,
             (if List.exists (Ident.equal id) (get_exceptions rem) then rem
-            else Sig_exception(id, arg.exn_exn) :: rem),
+             else Sig_exception(id, decl) :: rem),
             final_env
-        | Psig_module(name, smty) ->
-            check "module" item.psig_loc module_names name.txt;
-            let tmty = transl_modtype env smty in
+        | Psig_module pmd ->
+            check "module" item.psig_loc module_names pmd.pmd_name.txt;
+            let tmty = transl_modtype env pmd.pmd_type in
             let mty = tmty.mty_type in
-            let (id, newenv) = Env.enter_module name.txt mty env in
+            let (id, newenv) = Env.enter_module pmd.pmd_name.txt mty env in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_module (id, name, tmty)) env loc :: trem,
+            mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name; md_type=tmty; md_attributes=pmd.pmd_attributes}) env loc :: trem,
             Sig_module(id, mty, Trec_not) :: rem,
             final_env
         | Psig_recmodule sdecls ->
             List.iter
-              (fun (name, smty) ->
-                 check "module" item.psig_loc module_names name.txt)
+              (fun pmd ->
+                 check "module" item.psig_loc module_names pmd.pmd_name.txt)
               sdecls;
             let (decls, newenv) =
               transl_recmodule_modtypes item.psig_loc env sdecls in
             let (trem, rem, final_env) = transl_sig newenv srem in
             mksig (Tsig_recmodule decls) env loc :: trem,
-            map_rec (fun rs (id, _, tmty) -> Sig_module(id, tmty.mty_type, rs))
+            map_rec (fun rs md -> Sig_module(md.md_id, md.md_type.mty_type, rs))
               decls rem,
             final_env
-        | Psig_modtype(name, sinfo) ->
-            check "module type" item.psig_loc modtype_names name.txt;
-            let (tinfo, info) = transl_modtype_info env sinfo in
-            let (id, newenv) = Env.enter_modtype name.txt info env in
+        | Psig_modtype pmtd ->
+            let newenv, mtd, sg =
+              transl_modtype_decl modtype_names env item.psig_loc pmtd
+            in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_modtype (id, name, tinfo)) env loc :: trem,
-            Sig_modtype(id, info) :: rem,
+            mksig (Tsig_modtype mtd) env loc :: trem,
+            sg :: rem,
             final_env
-        | Psig_open (ovf, lid) ->
+        | Psig_open (ovf, lid, attrs) ->
             let (path, newenv) = type_open ovf env item.psig_loc lid in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_open (ovf, path,lid)) env loc :: trem,
+            mksig (Tsig_open (ovf, path,lid,attrs)) env loc :: trem,
             rem, final_env
-        | Psig_include smty ->
+        | Psig_include (smty, attrs) ->
             let tmty = transl_modtype env smty in
             let mty = tmty.mty_type in
             let sg = Subst.signature Subst.identity
@@ -539,7 +559,7 @@ and transl_signature env sg =
               sg;
             let newenv = Env.add_signature sg env in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_include (tmty, sg)) env loc :: trem,
+            mksig (Tsig_include (tmty, sg, attrs)) env loc :: trem,
             remove_duplicates (get_values rem) (get_exceptions rem) sg @ rem,
             final_env
         | Psig_class cl ->
@@ -584,6 +604,11 @@ and transl_signature env sg =
                     Sig_type(i'', d'', rs)])
                  classes [rem]),
             final_env
+        | Psig_attribute x ->
+            let (trem,rem, final_env) = transl_sig env srem in
+            mksig (Tsig_attribute x) env loc :: trem, rem, final_env
+        | Psig_extension ((s, _), _) ->
+            raise (Error (s.loc, env, Extension s.txt))
   in
   let previous_saved_types = Cmt_format.get_saved_types () in
   let (trem, rem, final_env) = transl_sig (Env.in_signature env) sg in
@@ -592,13 +617,28 @@ and transl_signature env sg =
     ((Cmt_format.Partial_signature sg) :: previous_saved_types);
   sg
 
+and transl_modtype_decl modtype_names env loc
+    {pmtd_name; pmtd_type; pmtd_attributes} =
+  check "module type" loc modtype_names pmtd_name.txt;
+  let (tinfo, info) = transl_modtype_info env pmtd_type in
+  let (id, newenv) = Env.enter_modtype pmtd_name.txt info env in
+  let mtd =
+    {
+     mtd_id=id;
+     mtd_name=pmtd_name;
+     mtd_type=tinfo;
+     mtd_attributes=pmtd_attributes;
+    }
+  in
+  newenv, mtd, Sig_modtype(id, info)
+
 and transl_modtype_info env sinfo =
   match sinfo with
-    Pmodtype_abstract ->
-      Tmodtype_abstract, Modtype_abstract
-  | Pmodtype_manifest smty ->
+    None ->
+      None, Modtype_abstract
+  | Some smty ->
       let tmty = transl_modtype env smty in
-      Tmodtype_manifest tmty, Modtype_manifest tmty.mty_type
+      Some tmty, Modtype_manifest tmty.mty_type
 
 and transl_recmodule_modtypes loc env sdecls =
   let make_env curr =
@@ -611,9 +651,9 @@ and transl_recmodule_modtypes loc env sdecls =
       env curr in
   let transition env_c curr =
     List.map2
-      (fun (_,smty) (id,id_loc,mty) -> (id, id_loc, transl_modtype env_c smty))
+      (fun pmd (id, id_loc, mty) -> (id, id_loc, transl_modtype env_c pmd.pmd_type))
       sdecls curr in
-  let ids = List.map (fun (name, _) -> Ident.create name.txt) sdecls in
+  let ids = List.map (fun x -> Ident.create x.pmd_name.txt) sdecls in
   let approx_env =
     (*
        cf #5965
@@ -630,8 +670,8 @@ and transl_recmodule_modtypes loc env sdecls =
   in
   let init =
     List.map2
-      (fun id (name, smty) ->
-         (id, name, approx_modtype approx_env smty))
+      (fun id pmd ->
+        (id, pmd.pmd_name, approx_modtype approx_env pmd.pmd_type))
       ids sdecls
   in
   let env0 = make_env init in
@@ -647,6 +687,12 @@ and transl_recmodule_modtypes loc env sdecls =
 *)
   let env2 = make_env2 dcl2 in
   check_recmod_typedecls env2 sdecls dcl2;
+  let dcl2 =
+    List.map2
+      (fun pmd (id, id_loc, mty) ->
+        {md_id=id; md_name=id_loc; md_type=mty; md_attributes=pmd.pmd_attributes})
+      sdecls dcl2
+  in
   (dcl2, env2)
 
 (* Try to convert a module expression to a module path. *)
@@ -676,11 +722,11 @@ let check_nongen_scheme env str =
   match str.str_desc with
     Tstr_value(rec_flag, pat_exp_list) ->
       List.iter
-        (fun (pat, exp) ->
+        (fun {vb_expr=exp} ->
           if not (Ctype.closed_schema exp.exp_type) then
             raise(Error(exp.exp_loc, env, Non_generalizable exp.exp_type)))
         pat_exp_list
-  | Tstr_module(id, _, md) ->
+  | Tstr_module {mb_expr=md;_} ->
       if not (closed_modtype md.mod_type) then
         raise(Error(md.mod_loc, env, Non_generalizable_module md.mod_type))
   | _ -> ()
@@ -700,7 +746,8 @@ let enrich_type_decls anchor decls oldenv newenv =
     None -> newenv
   | Some p ->
       List.fold_left
-        (fun e (id, _, info) ->
+        (fun e info ->
+          let id = info.typ_id in
           let info' =
             Mtype.enrich_typedecl oldenv (Pdot(p, Ident.name id, nopos))
               info.typ_type
@@ -743,7 +790,7 @@ let check_recmodule_inclusion env bindings =
       (* Generate fresh names Y_i for the rec. bound module idents X_i *)
       let bindings1 =
         List.map
-          (fun (id, _, mty_decl, modl, mty_actual) ->
+          (fun (id, _, mty_decl, modl, mty_actual, _attrs) ->
              (id, Ident.rename id, mty_actual))
           bindings in
       (* Enter the Y_i in the environment with their actual types substituted
@@ -768,7 +815,7 @@ let check_recmodule_inclusion env bindings =
     end else begin
       (* Base case: check inclusion of s(mty_actual) in s(mty_decl)
          and insert coercion if needed *)
-      let check_inclusion (id, id_loc, mty_decl, modl, mty_actual) =
+      let check_inclusion (id, id_loc, mty_decl, modl, mty_actual, attrs) =
         let mty_decl' = Subst.modtype s mty_decl.mty_type
         and mty_actual' = subst_and_strengthen env s id mty_actual in
         let coercion =
@@ -779,10 +826,18 @@ let check_recmodule_inclusion env bindings =
         let modl' =
             { mod_desc = Tmod_constraint(modl, mty_decl.mty_type,
                 Tmodtype_explicit mty_decl, coercion);
-            mod_type = mty_decl.mty_type;
-            mod_env = env;
-            mod_loc = modl.mod_loc } in
-        (id, id_loc, mty_decl, modl') in
+              mod_type = mty_decl.mty_type;
+              mod_env = env;
+              mod_loc = modl.mod_loc;
+              mod_attributes = [];
+             } in
+        {
+         mb_id = id;
+         mb_name = id_loc;
+         mb_expr = modl';
+         mb_attributes = attrs;
+        }
+      in
       List.map check_inclusion bindings
     end
   in check_incl true (List.length bindings) env Subst.identity
@@ -834,6 +889,7 @@ let wrap_constraint env arg mty explicit =
   { mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
     mod_type = mty;
     mod_env = env;
+    mod_attributes = [];
     mod_loc = arg.mod_loc }
 
 (* Type a module value expression *)
@@ -845,6 +901,7 @@ let rec type_module sttn funct_body anchor env smod =
       rm { mod_desc = Tmod_ident (path, lid);
            mod_type = if sttn then Mtype.strengthen env mty path else mty;
            mod_env = env;
+           mod_attributes = smod.pmod_attributes;
            mod_loc = smod.pmod_loc }
   | Pmod_structure sstr ->
       let (str, sg, finalenv) =
@@ -852,6 +909,7 @@ let rec type_module sttn funct_body anchor env smod =
       rm { mod_desc = Tmod_structure str;
            mod_type = Mty_signature sg;
            mod_env = env;
+           mod_attributes = smod.pmod_attributes;
            mod_loc = smod.pmod_loc }
   | Pmod_functor(name, smty, sbody) ->
       let mty = transl_modtype env smty in
@@ -860,6 +918,7 @@ let rec type_module sttn funct_body anchor env smod =
       rm { mod_desc = Tmod_functor(id, name, mty, body);
            mod_type = Mty_functor(id, mty.mty_type, body.mod_type);
            mod_env = env;
+           mod_attributes = smod.pmod_attributes;
            mod_loc = smod.pmod_loc }
   | Pmod_apply(sfunct, sarg) ->
       let arg = type_module true funct_body None env sarg in
@@ -889,6 +948,7 @@ let rec type_module sttn funct_body anchor env smod =
           rm { mod_desc = Tmod_apply(funct, arg, coercion);
                mod_type = mty_appl;
                mod_env = env;
+               mod_attributes = smod.pmod_attributes;
                mod_loc = smod.pmod_loc }
       | _ ->
           raise(Error(sfunct.pmod_loc, env, Cannot_apply funct.mod_type))
@@ -897,7 +957,9 @@ let rec type_module sttn funct_body anchor env smod =
       let arg = type_module true funct_body anchor env sarg in
       let mty = transl_modtype env smty in
       rm {(wrap_constraint env arg mty.mty_type (Tmodtype_explicit mty)) with
-          mod_loc = smod.pmod_loc}
+          mod_loc = smod.pmod_loc;
+          mod_attributes = smod.pmod_attributes;
+         }
 
   | Pmod_unpack sexp ->
       if funct_body then
@@ -929,7 +991,10 @@ let rec type_module sttn funct_body anchor env smod =
       rm { mod_desc = Tmod_unpack(exp, mty);
            mod_type = mty;
            mod_env = env;
+           mod_attributes = smod.pmod_attributes;
            mod_loc = smod.pmod_loc }
+  | Pmod_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
 
 and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
   let type_names = ref StringSet.empty
@@ -949,9 +1014,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
             str
           in
             match pstr.pstr_desc with
-              | Pstr_eval sexpr ->
+              | Pstr_eval (sexpr, attrs) ->
                   let expr = Typecore.type_expression env sexpr in
-                  let item = mk (Tstr_eval expr) in
+                  let item = mk (Tstr_eval (expr, attrs)) in
                   let (str_rem, sig_rem, final_env) = type_struct env srem in
                   (item :: str_rem, sig_rem, final_env)
               | Pstr_value(rec_flag, sdefs) ->
@@ -964,7 +1029,6 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                 | [] -> loc.Location.loc_end
                 | {pstr_loc = loc2} :: _ -> loc2.Location.loc_start
               in Some (Annot.Idef {scope with Location.loc_start = start})
-          | Default -> None
         in
         let (defs, newenv) =
           Typecore.type_binding env rec_flag sdefs scope in
@@ -978,16 +1042,14 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         (item :: str_rem,
          map_end make_sig_value bound_idents sig_rem,
          final_env)
-    | Pstr_primitive(name, sdesc) ->
-        let desc = Typedecl.transl_value_decl env loc sdesc in
-        let (id, newenv) = Env.enter_value name.txt desc.val_val env
-            ~check:(fun s -> Warnings.Unused_value_declaration s) in
-        let item = mk (Tstr_primitive(id, name, desc)) in
+    | Pstr_primitive sdesc ->
+        let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
+        let item = mk (Tstr_primitive desc) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
-        (item :: str_rem, Sig_value(id, desc.val_val) :: sig_rem, final_env)
+        (item :: str_rem, Sig_value(desc.val_id, desc.val_val) :: sig_rem, final_env)
     | Pstr_type sdecls ->
         List.iter
-          (fun (name, decl) -> check "type" loc type_names name.txt)
+          (fun decl -> check "type" loc type_names decl.ptype_name.txt)
           sdecls;
         let (decls, newenv) = Typedecl.transl_type_decl env sdecls in
         let item = mk (Tstr_type decls) in
@@ -995,76 +1057,93 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
           enrich_type_decls anchor decls env newenv in
         let (str_rem, sig_rem, final_env) = type_struct newenv' srem in
         (item :: str_rem,
-         map_rec'' (fun rs (id, _, info) -> Sig_type(id, info.typ_type, rs))
+         map_rec'' (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs))
            decls sig_rem,
          final_env)
-    | Pstr_exception(name, sarg) ->
-        let arg = Typedecl.transl_exception env loc sarg in
-        let (id, newenv) = Env.enter_exception name.txt arg.exn_exn env in
-        let item = mk (Tstr_exception(id, name, arg)) in
+    | Pstr_exception sarg ->
+        let (arg, decl, newenv) = Typedecl.transl_exception env sarg in
+        let item = mk (Tstr_exception arg) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
-         Sig_exception(id, arg.exn_exn) :: sig_rem,
+         Sig_exception(arg.cd_id, decl) :: sig_rem,
          final_env)
-    | Pstr_exn_rebind(name, longid) ->
+    | Pstr_exn_rebind(name, longid, attrs) ->
         let (path, arg) = Typedecl.transl_exn_rebind env loc longid.txt in
         let (id, newenv) = Env.enter_exception name.txt arg env in
-        let item = mk (Tstr_exn_rebind(id, name, path, longid)) in
+        let item = mk (Tstr_exn_rebind(id, name, path, longid, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
          Sig_exception(id, arg) :: sig_rem,
          final_env)
-    | Pstr_module(name, smodl) ->
+    | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs} ->
         check "module" loc module_names name.txt;
         let modl =
           type_module true funct_body (anchor_submodule name.txt anchor) env
             smodl in
         let mty = enrich_module_type anchor name.txt modl.mod_type env in
         let (id, newenv) = Env.enter_module name.txt mty env in
-        let item = mk (Tstr_module(id, name, modl)) in
+        let item = mk
+            (Tstr_module
+               {
+                mb_id=id;
+                mb_name=name;
+                mb_expr=modl;
+                mb_attributes=attrs;
+               }
+            )
+        in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
          Sig_module(id, modl.mod_type, Trec_not) :: sig_rem,
          final_env)
     | Pstr_recmodule sbind ->
+        let sbind =
+          List.map
+            (function
+              | {pmb_name = name; pmb_expr = {pmod_desc=Pmod_constraint(expr, typ)}; pmb_attributes = attrs} ->
+                  name, typ, expr, attrs
+              | mb ->
+                  raise (Error (mb.pmb_expr.pmod_loc, env, Recursive_module_require_explicit_type))
+            )
+            sbind
+        in
         List.iter
-          (fun (name, _, _) -> check "module" loc module_names name.txt)
+          (fun (name, _, _, _) -> check "module" loc module_names name.txt)
           sbind;
         let (decls, newenv) =
           transl_recmodule_modtypes loc env
-            (List.map (fun (name, smty, smodl) -> (name, smty)) sbind) in
+            (List.map (fun (name, smty, smodl, attrs) -> {pmd_name=name; pmd_type=smty; pmd_attributes=attrs}) sbind) in
         let bindings1 =
           List.map2
-            (fun (id, _, mty) (name, _, smodl) ->
+            (fun {md_id=id; md_type=mty} (name, _, smodl, attrs) ->
               let modl =
                 type_module true funct_body (anchor_recmodule id anchor) newenv
                   smodl in
               let mty' =
                 enrich_module_type anchor (Ident.name id) modl.mod_type newenv
               in
-              (id, name, mty, modl, mty'))
+              (id, name, mty, modl, mty', attrs))
            decls sbind in
         let bindings2 =
           check_recmodule_inclusion newenv bindings1 in
         let item = mk (Tstr_recmodule bindings2) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
-         map_rec (fun rs (id, _, _, modl) -> Sig_module(id, modl.mod_type, rs))
+         map_rec (fun rs mb -> Sig_module(mb.mb_id, mb.mb_expr.mod_type, rs))
                  bindings2 sig_rem,
          final_env)
-    | Pstr_modtype(name, smty) ->
-        check "module type" loc modtype_names name.txt;
-        let mty = transl_modtype env smty in
-        let (id, newenv) =
-          Env.enter_modtype name.txt (Modtype_manifest mty.mty_type) env in
-        let item = mk (Tstr_modtype(id, name, mty)) in
+    | Pstr_modtype pmtd ->
+        (* check that it is non-abstract *)
+        let newenv, mtd, sg =
+          transl_modtype_decl modtype_names env loc pmtd
+        in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
-        (item :: str_rem,
-         Sig_modtype(id, Modtype_manifest mty.mty_type) :: sig_rem,
-         final_env)
-    | Pstr_open (ovf, lid) ->
+        mk (Tstr_modtype mtd) :: str_rem,
+        sg :: sig_rem,
+        final_env
+    | Pstr_open (ovf, lid, attrs) ->
         let (path, newenv) = type_open ovf ~toplevel env loc lid in
-        let item = mk (Tstr_open (ovf, path, lid)) in
+        let item = mk (Tstr_open (ovf, path, lid, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem, sig_rem, final_env)
     | Pstr_class cl ->
@@ -1124,7 +1203,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                   Sig_type(i'', d'', rs)])
               classes [sig_rem]),
          final_env)
-    | Pstr_include smodl ->
+    | Pstr_include (smodl, attrs) ->
         let modl = type_module true funct_body None env smodl in
         (* Rename all identifiers bound by this signature to avoid clashes *)
         let sg = Subst.signature Subst.identity
@@ -1132,11 +1211,16 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         List.iter
           (check_sig_item type_names module_names modtype_names loc) sg;
         let new_env = Env.add_signature sg env in
-        let item = mk (Tstr_include (modl, sg)) in
+        let item = mk (Tstr_include (modl, sg, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct new_env srem in
         (item :: str_rem,
          sg @ sig_rem,
          final_env)
+    | Pstr_extension ((s, _), _) ->
+        raise (Error (s.loc, env, Extension s.txt))
+    | Pstr_attribute x ->
+        let (str_rem, sig_rem, final_env) = type_struct env srem in
+        mk (Tstr_attribute x) :: str_rem, sig_rem, final_env
   in
   if !Clflags.annotations then
     (* moved to genannot *)
@@ -1208,6 +1292,7 @@ let type_module_type_of env smod =
         rm { mod_desc = Tmod_ident (path, lid);
              mod_type = mty;
              mod_env = env;
+             mod_attributes = smod.pmod_attributes;
              mod_loc = smod.pmod_loc }
     | _ -> type_module env smod in
   let mty = tmty.mod_type in
@@ -1473,6 +1558,10 @@ let report_error ppf = function
         "The type %a in this module cannot be exported.@ " longident lid;
       fprintf ppf
         "Its type contains local dependencies:@ %a" type_expr ty
+  | Extension s ->
+      fprintf ppf "Uninterpreted extension '%s'." s
+  | Recursive_module_require_explicit_type ->
+      fprintf ppf "Recursive modules require an explicit module type."
 
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error ppf err)
diff --git a/typing/typemod.mli b/typing/typemod.mli
index cda00694a..20868d33f 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -58,6 +58,8 @@ type error =
   | Not_a_packed_module of type_expr
   | Incomplete_packed_module of type_expr
   | Scoping_pack of Longident.t * type_expr
+  | Extension of string
+  | Recursive_module_require_explicit_type
 
 exception Error of Location.t * Env.t * error
 
diff --git a/typing/types.ml b/typing/types.ml
index 426311645..f5d952764 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -202,7 +202,7 @@ module Concr = Set.Make(OrderedString)
 type class_type =
     Cty_constr of Path.t * type_expr list * class_type
   | Cty_signature of class_signature
-  | Cty_fun of label * type_expr * class_type
+  | Cty_arrow of label * type_expr * class_type
 
 and class_signature =
   { cty_self: type_expr;
diff --git a/typing/types.mli b/typing/types.mli
index 2020e2582..94559e2e1 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -190,7 +190,7 @@ module Concr : Set.S with type elt = string
 type class_type =
     Cty_constr of Path.t * type_expr list * class_type
   | Cty_signature of class_signature
-  | Cty_fun of label * type_expr * class_type
+  | Cty_arrow of label * type_expr * class_type
 
 and class_signature =
   { cty_self: type_expr;
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index f9c0ecd7b..7d6a9f864 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -21,7 +21,7 @@ open Typedtree
 open Types
 open Ctype
 
-exception Already_bound
+exception Already_bound of Location.t
 
 type error =
     Unbound_type_variable of string
@@ -51,6 +51,7 @@ type error =
   | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
   | Illegal_reference_to_recursive_module
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
@@ -140,17 +141,17 @@ let create_package_mty fake loc env (p, l) =
   l,
   List.fold_left
     (fun mty (s, t) ->
-      let d = {ptype_params = [];
+      let d = {ptype_name = mkloc (Longident.last s.txt) s.loc;
+               ptype_params = [];
                ptype_cstrs = [];
                ptype_kind = Ptype_abstract;
                ptype_private = Asttypes.Public;
                ptype_manifest = if fake then None else Some t;
-               ptype_variance = [];
+               ptype_attributes = [];
                ptype_loc = loc} in
-      {pmty_desc=Pmty_with (mty, [ { txt = s.txt; loc }, Pwith_type d ]);
-       pmty_loc=loc}
+      Ast_helper.Mty.mk ~loc (Pmty_with (mty, [ Pwith_type ({ txt = s.txt; loc }, d) ]))
     )
-    {pmty_desc=Pmty_ident p; pmty_loc=loc}
+    (Ast_helper.Mty.mk ~loc (Pmty_ident p))
     l
 
 (* Translation of type expressions *)
@@ -183,12 +184,12 @@ let new_global_var ?name () =
 let newvar ?name () =
   newvar ?name:(validate_name name) ()
 
-let enter_type_variable strict loc name =
+let enter_type_variable {Location.txt=name; loc} =
   try
     if name <> "" && name.[0] = '_' then
       raise (Error (loc, Env.empty, Invalid_variable_name ("'" ^ name)));
     let v = Tbl.find name !type_variables in
-    if strict then raise Already_bound;
+    raise (Already_bound loc);
     v
   with Not_found ->
     let v = new_global_var ~name () in
@@ -215,11 +216,11 @@ let rec swap_list = function
 
 type policy = Fixed | Extensible | Univars
 
-let ctyp ctyp_desc ctyp_type ctyp_env ctyp_loc =
-  { ctyp_desc; ctyp_type; ctyp_env; ctyp_loc }
-
 let rec transl_type env policy styp =
   let loc = styp.ptyp_loc in
+  let ctyp ctyp_desc ctyp_type =
+    { ctyp_desc; ctyp_type; ctyp_env = env; ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes }
+  in
   match styp.ptyp_desc with
     Ptyp_any ->
       let ty =
@@ -228,7 +229,7 @@ let rec transl_type env policy styp =
             raise (Error (styp.ptyp_loc, env, Unbound_type_variable "_"))
           else newvar ()
       in
-      ctyp Ttyp_any ty env loc
+      ctyp Ttyp_any ty
   | Ptyp_var name ->
     let ty =
       if name <> "" && name.[0] = '_' then
@@ -245,16 +246,16 @@ let rec transl_type env policy styp =
         v
       end
     in
-    ctyp (Ttyp_var name) ty env loc
+    ctyp (Ttyp_var name) ty
   | Ptyp_arrow(l, st1, st2) ->
     let cty1 = transl_type env policy st1 in
     let cty2 = transl_type env policy st2 in
     let ty = newty (Tarrow(l, cty1.ctyp_type, cty2.ctyp_type, Cok)) in
-    ctyp (Ttyp_arrow (l, cty1, cty2)) ty env loc
+    ctyp (Ttyp_arrow (l, cty1, cty2)) ty
   | Ptyp_tuple stl ->
     let ctys = List.map (transl_type env policy) stl in
     let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in
-    ctyp (Ttyp_tuple ctys) ty env loc
+    ctyp (Ttyp_tuple ctys) ty
   | Ptyp_constr(lid, stl) ->
       let (path, decl) = find_type env styp.ptyp_loc lid.txt in
       if List.length stl <> decl.type_arity then
@@ -281,22 +282,15 @@ let rec transl_type env policy styp =
       with Unify trace ->
         raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
       end;
-        ctyp (Ttyp_constr (path, lid, args)) constr env loc
-  | Ptyp_object fields ->
-      let fields = List.map
-          (fun pf ->
-            let desc =
-              match pf.pfield_desc with
-              | Pfield_var -> Tcfield_var
-              | Pfield (s,e) ->
-                  let ty1 = transl_type env policy e in
-                  Tcfield (s, ty1)
-            in
-            { field_desc = desc; field_loc = pf.pfield_loc })
-          fields in
-      let ty = newobj (transl_fields env policy [] fields) in
-        ctyp (Ttyp_object fields) ty env loc
-  | Ptyp_class(lid, stl, present) ->
+      ctyp (Ttyp_constr (path, lid, args)) constr
+  | Ptyp_object (fields, o) ->
+      let fields =
+        List.map (fun (s, t) -> (s, transl_poly_type env policy t))
+          fields
+      in
+      let ty = newobj (transl_fields loc env policy [] o fields) in
+      ctyp (Ttyp_object (fields, o)) ty
+  | Ptyp_class(lid, stl) ->
       let (path, decl, is_variant) =
         try
           let (path, decl) = Env.lookup_type lid.txt env in
@@ -314,7 +308,6 @@ let rec transl_type env policy styp =
             (Warnings.Deprecated "old syntax for polymorphic variant type");
           (path, decl,true)
         with Not_found -> try
-          if present <> [] then raise Not_found;
           let lid2 =
             match lid.txt with
               Longident.Lident s     -> Longident.Lident ("#" ^ s)
@@ -346,14 +339,9 @@ let rec transl_type env policy styp =
       let ty = match ty.desc with
         Tvariant row ->
           let row = Btype.row_repr row in
-          List.iter
-            (fun l -> if not (List.mem_assoc l row.row_fields) then
-              raise(Error(styp.ptyp_loc, env, Present_has_no_type l)))
-            present;
           let fields =
             List.map
               (fun (l,f) -> l,
-                if List.mem l present then f else
                 match Btype.row_field_repr f with
                 | Rpresent (Some ty) ->
                     Reither(false, [ty], false, ref None)
@@ -379,7 +367,7 @@ let rec transl_type env policy styp =
       | _ ->
           assert false
       in
-        ctyp (Ttyp_class (path, lid, args, present)) ty env loc
+      ctyp (Ttyp_class (path, lid, args)) ty
   | Ptyp_alias(st, alias) ->
       let cty =
         try
@@ -416,7 +404,7 @@ let rec transl_type env policy styp =
           end;
           { ty with ctyp_type = t }
       in
-      ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type env loc
+      ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type
   | Ptyp_variant(fields, closed, present) ->
       let name = ref None in
       let mkfield l f =
@@ -509,7 +497,7 @@ let rec transl_type env policy styp =
       end;
       let row =
         { row_fields = List.rev fields; row_more = newvar ();
-          row_bound = (); row_closed = closed;
+          row_bound = (); row_closed = (closed = Closed);
           row_fixed = false; row_name = !name } in
       let static = Btype.static_row row in
       let row =
@@ -518,7 +506,7 @@ let rec transl_type env policy styp =
         else { row with row_more = new_pre_univar () }
       in
       let ty = newty (Tvariant row) in
-      ctyp (Ttyp_variant (tfields, closed, present)) ty env loc
+      ctyp (Ttyp_variant (tfields, closed, present)) ty
    | Ptyp_poly(vars, st) ->
       begin_def();
       let new_univars = List.map (fun name -> name, newvar ~name ()) vars in
@@ -545,7 +533,7 @@ let rec transl_type env policy styp =
       in
       let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
       unify_var env (newvar()) ty';
-      ctyp (Ttyp_poly (vars, cty)) ty' env loc
+      ctyp (Ttyp_poly (vars, cty)) ty'
   | Ptyp_package (p, l) ->
       let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in
       let z = narrow () in
@@ -559,23 +547,30 @@ let rec transl_type env policy styp =
                        List.map (fun (s, pty) -> s.txt) l,
                        List.map (fun (_,cty) -> cty.ctyp_type) ptys))
       in
-        ctyp (Ttyp_package {
-                pack_name = path;
-                pack_type = mty.mty_type;
-                pack_fields = ptys;
-                pack_txt = p;
-              }) ty env loc
-
-and transl_fields env policy seen =
+      ctyp (Ttyp_package {
+            pack_name = path;
+            pack_type = mty.mty_type;
+            pack_fields = ptys;
+            pack_txt = p;
+           }) ty
+  | Ptyp_extension (s, _arg) ->
+      raise (Error (s.loc, env, Extension s.txt))
+
+and transl_poly_type env policy t =
+  transl_type env policy (Ast_helper.Typ.force_poly t)
+
+and transl_fields loc env policy seen o =
   function
     [] ->
-      newty Tnil
-  | {field_desc = Tcfield_var}::_ ->
-      if policy = Univars then new_pre_univar () else newvar ()
-  | {field_desc = Tcfield(s, ty1); field_loc = loc}::l ->
+      begin match o, policy with
+      | Closed, _ -> newty Tnil
+      | Open, Univars -> new_pre_univar ()
+      | Open, _ -> newvar ()
+      end
+  | (s, ty1) :: l ->
       if List.mem s seen then raise (Error (loc, env, Repeated_method_label s));
-      let ty2 = transl_fields env policy (s::seen) l in
-        newty (Tfield (s, Fpresent, ty1.ctyp_type, ty2))
+      let ty2 = transl_fields loc env policy (s :: seen) o l in
+      newty (Tfield (s, Fpresent, ty1.ctyp_type, ty2))
 
 (* Make the rows "fixed" in this type, to make universal check easier *)
 let rec make_fixed_univars ty =
@@ -827,3 +822,5 @@ let report_error env ppf = function
       fprintf ppf "Ill-typed functor application %a" longident lid
   | Illegal_reference_to_recursive_module ->
       fprintf ppf "Illegal recursive module reference"
+  | Extension s ->
+      fprintf ppf "Uninterpreted extension '%s'." s
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index 66ffb7b8c..eb78d1ae1 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -25,14 +25,14 @@ val transl_simple_type_delayed:
 val transl_type_scheme:
         Env.t -> Parsetree.core_type -> Typedtree.core_type
 val reset_type_variables: unit -> unit
-val enter_type_variable: bool -> Location.t -> string -> type_expr
+val enter_type_variable: string Location.loc -> type_expr
 val type_variable: Location.t -> string -> type_expr
 
 type variable_context
 val narrow: unit -> variable_context
 val widen: variable_context -> unit
 
-exception Already_bound
+exception Already_bound of Location.t
 
 type error =
     Unbound_type_variable of string
@@ -62,6 +62,7 @@ type error =
   | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
   | Illegal_reference_to_recursive_module
+  | Extension of string
 
 exception Error of Location.t * Env.t * error