[Pkg-ocaml-maint-commits] [ppx-tools] 02/05: New upstream version 5.0+4.05.0
Stéphane Glondu
glondu at moszumanska.debian.org
Wed Jul 19 17:03:03 UTC 2017
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 <steph at 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 : [](https://travis-ci.org/alainfrisch/ppx_tools)
+
+4.05 : [](https://travis-ci.org/alainfrisch/ppx_tools)
+
+4.04 : [](https://travis-ci.org/alainfrisch/ppx_tools)
+
+4.03 : [](https://travis-ci.org/alainfrisch/ppx_tools)
+
+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 at ." 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.frisch at lexifi.com"
authors: [ "Alain Frisch <alain.frisch at 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
More information about the Pkg-ocaml-maint-commits
mailing list