This is an automated email from the git hooks/post-receive script. glondu pushed a commit to branch master in repository ppx-tools.
commit de6f5d1858d3c4f37dd16324debf5c3ac151be9a Author: Stephane Glondu <st...@glondu.net> Date: Wed Jul 19 18:59:49 2017 +0200 New upstream version 5.0+4.05.0 --- .travis.yml | 12 ++++++++++++ README.md | 14 ++++++++++++-- ast_convenience.ml | 2 ++ ast_convenience.mli | 2 ++ ast_mapper_class.ml | 5 +++++ genlifter.ml | 20 ++++++++++---------- opam | 3 ++- ppx_metaquot.ml | 47 ++++++++++++++++++++++++++++++++++++++++++++++- rewriter.ml | 4 ++-- 9 files changed, 93 insertions(+), 16 deletions(-) diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..dd7d6d8 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,12 @@ +language: c +sudo: false +services: + - docker +install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh +script: bash -ex .travis-docker.sh +env: + global: + - PACKAGE="ppx_tools" + - PRE_INSTALL_HOOK="cd /home/opam/opam-repository && git pull origin master && opam update -u -y" + matrix: + - DISTRO=ubuntu-16.04 OCAML_VERSION=4.05.0 diff --git a/README.md b/README.md index a75fbf0..1c88d45 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,17 @@ Main contributors: - Alain Frisch - Peter Zotov (whitequark) - - Gabriel Radanne (Drup) + - Gabriel Radanne (Drup) + +Master : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=master)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.05 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.05)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.04 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.04)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.03 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.03)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.02 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.02)](https://travis-ci.org/alainfrisch/ppx_tools) ppx_metaquot ------------ @@ -26,7 +36,7 @@ supported extensions. Usage: - ocamlfind -c -package ppx_tools.metaquot my_ppx_code.ml + ocamlfind ocamlc -c -package ppx_tools.metaquot my_ppx_code.ml rewriter diff --git a/ast_convenience.ml b/ast_convenience.ml index 7d73bf8..fe3c4a2 100644 --- a/ast_convenience.ml +++ b/ast_convenience.ml @@ -55,6 +55,8 @@ let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Pconst_string (s, None)) let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let int32 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int32.to_string x, Some 'l')) +let int64 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int64.to_string x, Some 'L')) let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_char x) let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) let record ?loc ?attrs ?over l = diff --git a/ast_convenience.mli b/ast_convenience.mli index fd6246b..3ac31fd 100644 --- a/ast_convenience.mli +++ b/ast_convenience.mli @@ -68,6 +68,8 @@ val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression val str: ?loc:loc -> ?attrs:attrs -> string -> expression val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val int32: ?loc:loc -> ?attrs:attrs -> int32 -> expression +val int64: ?loc:loc -> ?attrs:attrs -> int64 -> expression val char: ?loc:loc -> ?attrs:attrs -> char -> expression val float: ?loc:loc -> ?attrs:attrs -> float -> expression diff --git a/ast_mapper_class.ml b/ast_mapper_class.ml index 0f91ab4..1e04b5b 100644 --- a/ast_mapper_class.ml +++ b/ast_mapper_class.ml @@ -293,6 +293,10 @@ module E = struct | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) (sub # expr e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub # extension_constructor cd) + (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) -> @@ -335,6 +339,7 @@ module P = struct | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) + | Ppat_open (l, p) -> open_ ~loc ~attrs (map_loc sub l) (sub # pat p) end module CE = struct diff --git a/genlifter.ml b/genlifter.ml index a3eae47..bfed7a3 100644 --- a/genlifter.ml +++ b/genlifter.ml @@ -15,7 +15,7 @@ module Main : sig end = struct open Ast_helper open Ast_convenience - let selfcall ?(this = "this") m args = app (Exp.send (evar this) m) args + let selfcall ?(this = "this") m args = app (Exp.send (evar this) (mknoloc m)) args (*************************************************************************) @@ -38,19 +38,19 @@ module Main : sig end = struct let existential_method = Cf.(method_ (mknoloc "existential") Public - (virtual_ Typ.(poly ["a"] (arrow Nolabel (var "a") (var "res")))) + (virtual_ Typ.(poly [mknoloc "a"] (arrow Nolabel (var "a") (var "res")))) ) let arrow_method = Cf.(method_ (mknoloc "arrow") Public - (virtual_ Typ.(poly ["a"] (arrow Nolabel (var "a") (var "res")))) + (virtual_ Typ.(poly [mknoloc "a"] (arrow Nolabel (var "a") (var "res")))) ) 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 + let td = + try Env.find_type (Env.lookup_type tylid env) env with Not_found -> Format.eprintf "** Cannot resolve type %s@." ty; exit 2 @@ -63,8 +63,8 @@ module Main : sig end = struct | 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 params = List.mapi (fun i _ -> mknoloc (Printf.sprintf "f%i" i)) td.type_params in + let env = List.map2 (fun s t -> t.id, evar s.txt) params td.type_params in let make_result_t tyargs = Typ.(arrow Asttypes.Nolabel (constr (lid ty) tyargs) (var "res")) in let make_t tyargs = List.fold_right @@ -72,11 +72,11 @@ module Main : sig end = struct Typ.(arrow Asttypes.Nolabel (arrow Asttypes.Nolabel arg (var "res")) t)) tyargs (make_result_t tyargs) in - let tyargs = List.map (fun t -> Typ.var t) params in + let tyargs = List.map (fun t -> Typ.var t.txt) params in let t = Typ.poly params (make_t tyargs) in let concrete e = - let e = List.fold_right (fun x e -> lam x e) (List.map (fun x -> pvar x) params) e in - let tyargs = List.map (fun t -> Typ.constr (lid t) []) params in + let e = List.fold_right (fun x e -> lam x e) (List.map (fun x -> pvar x.txt) params) e in + let tyargs = List.map (fun t -> Typ.constr (lid t.txt) []) params in let e = Exp.constraint_ e (make_t tyargs) in let e = List.fold_right (fun x e -> Exp.newtype x e) params e in let body = Exp.poly e (Some t) in diff --git a/opam b/opam index c3c546a..e9106fc 100644 --- a/opam +++ b/opam @@ -1,4 +1,5 @@ opam-version: "1.2" +name: "ppx_tools" maintainer: "alain.fri...@lexifi.com" authors: [ "Alain Frisch <alain.fri...@lexifi.com>" ] license: "MIT" @@ -12,4 +13,4 @@ remove: [["ocamlfind" "remove" "ppx_tools"]] depends: [ "ocamlfind" {>= "1.5.0"} ] -available: ocaml-version >= "4.03.0" +available: ocaml-version >= "4.05.0" diff --git a/ppx_metaquot.ml b/ppx_metaquot.ml index 750e9e8..c63dbf1 100644 --- a/ppx_metaquot.ml +++ b/ppx_metaquot.ml @@ -11,6 +11,8 @@ [%pat? ...] maps to code which creates the pattern represented by ... [%str ...] maps to code which creates the structure represented by ... [%stri ...] maps to code which creates the structure item represented by ... + [%sig: ...] maps to code which creates the signature represented by ... + [%sigi: ...] maps to code which creates the signature item represented by ... [%type: ...] maps to code which creates the core type represented by ... Quoted code can refer to expressions representing AST fragments, @@ -19,6 +21,8 @@ [%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 + [%%s ...] where ... is an expression of type Parsetree.structure + or Parsetree.signature depending on the context. All locations generated by the meta quotation are by default set @@ -67,6 +71,10 @@ module Main : sig end = struct | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s | _ -> s + let append ?loc ?attrs e e' = + let fn = Location.mknoloc (Longident.(Ldot (Lident "List", "append"))) in + Exp.apply ?loc ?attrs (Exp.ident fn) [Nolabel, e; Nolabel, e'] + class exp_builder = object method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) @@ -135,6 +143,24 @@ module Main : sig end = struct | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) | x -> super # lift_Parsetree_pattern x + method! lift_Parsetree_structure str = + List.fold_right + (function + | {pstr_desc=Pstr_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_structure_item x)) + str (nil ()) + + method! lift_Parsetree_signature sign = + List.fold_right + (function + | {psig_desc=Psig_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_signature_item x)) + sign (nil ()) + method! lift_Parsetree_core_type = function | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) | x -> super # lift_Parsetree_core_type x @@ -192,6 +218,10 @@ module Main : sig end = struct (exp_lifter !loc this) # lift_Parsetree_structure e | Pexp_extension({txt="stri";_}, PStr [e]) -> (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="sig";_}, PSig e) -> + (exp_lifter !loc this) # lift_Parsetree_signature e + | Pexp_extension({txt="sigi";_}, PSig [e]) -> + (exp_lifter !loc this) # lift_Parsetree_signature_item e | Pexp_extension({txt="type";loc=l}, e) -> (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) | _ -> @@ -209,6 +239,10 @@ module Main : sig end = struct (pat_lifter this) # lift_Parsetree_structure e | Ppat_extension({txt="stri";_}, PStr [e]) -> (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="sig";_}, PSig e) -> + (pat_lifter this) # lift_Parsetree_signature e + | Ppat_extension({txt="sigi";_}, PSig [e]) -> + (pat_lifter this) # lift_Parsetree_signature_item e | Ppat_extension({txt="type";loc=l}, e) -> (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) | _ -> @@ -225,8 +259,19 @@ module Main : sig end = struct end; super.structure_item this x + and signature this l = + with_loc + (fun () -> super.signature this l) + + and signature_item this x = + begin match x.psig_desc with + | Psig_attribute x -> handle_attr x + | _ -> () + end; + super.signature_item this x + in - {super with expr; pat; structure; structure_item} + {super with expr; pat; structure; structure_item; signature; signature_item} let () = Ast_mapper.run_main expander end diff --git a/rewriter.ml b/rewriter.ml index 565e35b..6de0d16 100644 --- a/rewriter.ml +++ b/rewriter.ml @@ -92,13 +92,13 @@ let () = | `Struct -> let pstr = Parse.implementation lexer in let pstr = Pparse.apply_rewriters (* ~restore:true *) ~tool_name:!tool_name - Config.ast_impl_magic_number pstr in + Pparse.Structure pstr in Pprintast.structure fmt pstr; Format.pp_print_newline fmt () | `Sig -> let psig = Parse.interface lexer in let psig = Pparse.apply_rewriters (* ~restore:true *) ~tool_name:!tool_name - Config.ast_intf_magic_number psig in + Pparse.Signature psig in Pprintast.signature fmt psig; Format.pp_print_newline fmt ()) with exn -> -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ppx-tools.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits