This is an automated email from the git hooks/post-receive script. glondu pushed a commit to branch master in repository ocaml-atd.
commit e5ee6c56040a32f8211ab48f8b0078a9761fcbb4 Author: Stephane Glondu <st...@glondu.net> Date: Wed Jan 29 14:19:20 2014 +0100 Imported Upstream version 1.1.0 --- .gitignore | 21 +++++++++++++++++++++ Changes.txt | 16 ---------------- Makefile | 29 +++++++++++++++++++---------- README.md | 4 ++-- atd_expand.ml | 50 ++++++++++++++++++++++++++++++++++++++++++++------ atd_expand.mli | 13 ++++++++++++- atd_util.ml | 6 +++--- atd_util.mli | 14 ++++++++++---- atdcat.ml | 8 +++++--- manual/atd-body.mlx | 4 +++- 10 files changed, 119 insertions(+), 46 deletions(-) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ed20a65 --- /dev/null +++ b/.gitignore @@ -0,0 +1,21 @@ +*~ +*.cmi +*.cmo +*.cmx +*.cma +*.cmxa +*.a +*.o +*.annot +*.run +*.opt +*.exe +META +VERSION +atd_doc_lexer.ml +atd_lexer.ml +atd_parser.ml +atd_parser.mli +atd_version.ml +atdcat +dep diff --git a/Changes.txt b/Changes.txt deleted file mode 100644 index f84c8d2..0000000 --- a/Changes.txt +++ /dev/null @@ -1,16 +0,0 @@ - History of atd releases - -2012-02-07 1.0.2: - - new atdcat option "-html-doc" - - new atdcat options "-strip" and "-strip-all" - -2011-02-08 1.0.1: - bugfixes: - - fixed assert failure occurring when using atdcat -x with a polymorphic - abstract type - - location fix for list/option/shared - -2010-12-06 1.0.0: added support for shared types -2010-09-13 0.9.2: added INSTALL file -2010-09-09 0.9.1: documentation fixes only -2010-08-22 0.9.0: initial release diff --git a/Makefile b/Makefile index fec7bfe..68500a6 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,9 @@ -VERSION = 1.0.3 +VERSION = 1.1.0 +ifeq "$(shell ocamlc -config |grep os_type)" "os_type: Win32" +EXE=.exe +else +EXE= +endif SOURCES = \ atd_version.ml \ @@ -27,6 +32,8 @@ CMI = $(patsubst %.ml,%.cmi, $(ML)) CMO = $(patsubst %.ml,%.cmo, $(ML)) CMX = $(patsubst %.ml,%.cmx, $(ML)) O = $(patsubst %.ml,%.o, $(ML)) +INSTALL_EXTRAS = atd_check.ml atd_doc_lexer.mll atd_doc_lexer.ml \ + atd_lexer.mll atd_lexer.ml atd_predef.ml atd_version.ml OCAMLFLAGS = -dtypes -g OCAMLPACKS = easy-format unix str @@ -60,13 +67,14 @@ default: all opt all: VERSION META atd.cma -opt: VERSION META atd.cmxa atdcat +opt: VERSION META atd.cmxa atdcat$(EXE) install: META test ! -f atdcat || cp atdcat $(BINDIR)/ test ! -f atdcat.exe || cp atdcat.exe $(BINDIR)/ ocamlfind install atd META \ - `find $(MLI) $(CMI) $(CMO) $(CMX) $(O) atd.cma atd.a atd.cmxa` + $(MLI) $(CMI) $(CMO) $(CMX) $(O) atd.cma atd.a atd.cmxa \ + $(INSTALL_EXTRAS) uninstall: test ! -f $(BINDIR)/atdcat || rm $(BINDIR)/atdcat @@ -124,13 +132,13 @@ atd.cma: dep $(CMI) $(CMO) atd.cmxa: dep $(CMI) $(CMX) ocamlfind ocamlopt $(OCAMLFLAGS) -o atd.cmxa -a $(CMX) -atdcat: dep $(CMI) $(CMX) atdcat.ml - ocamlfind ocamlopt $(OCAMLFLAGS) -o atdcat \ +atdcat$(EXE): dep $(CMI) $(CMX) atdcat.ml + ocamlfind ocamlopt $(OCAMLFLAGS) -o atdcat$(EXE) \ -package "$(OCAMLPACKS)" -linkpkg \ $(CMX) atdcat.ml .PHONY: doc -doc: odoc/index.html atdcat +doc: odoc/index.html atdcat$(EXE) cd manual; $(MAKE) odoc/index.html: $(CMI) @@ -140,14 +148,14 @@ odoc/index.html: $(CMI) -package "$(OCAMLPACKS)" $(DOCSOURCES) .PHONY: test -test: atdcat test.atd test2.atd +test: atdcat$(EXE) test.atd test2.atd ./atdcat test.atd > test.out ./atdcat test.out > test.out.out cmp test.out test.out.out ./atdcat -x test2.atd > test2.out .PHONY: docdemo -docdemo: atdcat test.atd +docdemo: atdcat$(EXE) test.atd ./atdcat test.atd -html-doc -strip ocaml > test-out.atd caml2html -ext html:cat test-out.atd -nf sed -i -e 's!</style>!\ @@ -172,11 +180,12 @@ div.atd-doc pre { \ .PHONY: clean clean: rm -f dep - rm -f $(CMI) $(CMO) $(CMX) $(O) + rm atd_version.ml + rm -f $(CMI) $(CMO) $(CMX) $(O) *.annot *.cma *.cmxa *.a rm -f $(patsubst %.mly,%.mli, $(MLY)) rm -f $(patsubst %.mly,%.ml, $(MLY)) rm -f $(patsubst %.mll,%.ml, $(MLL)) - rm -f atdcat.cm[ioxa] atdcat.o atdcat.cma atdcat.cmxa + rm -f atdcat.cm[ioxa] atdcat.o atdcat.cma atdcat.cmxa atdcat$(EXE) rm -rf odoc cd manual; $(MAKE) clean diff --git a/README.md b/README.md index a5ba669..0af7ce0 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ ATD stands for Adaptable Type Definitions. It is a syntax for defining -cross-language data types and it is used by -[atdgen](https://github.com/MyLifeLabs/atdgen) for defining the +cross-language data types and it is used by +[atdgen](https://github.com/mjambon/atdgen) for defining the type of [JSON](http://json.org) data and generating efficient serializers, deserializers and validators. diff --git a/atd_expand.ml b/atd_expand.ml index 301228d..ce40ee0 100644 --- a/atd_expand.ml +++ b/atd_expand.ml @@ -62,6 +62,32 @@ open Atd_ast module S = Set.Make (String) module M = Map.Make (String) + +(* + To support -o-name-overlap, we need to generate a few type annotations. + But types generated by expansion like _1, _2, etc. are not actually + written out in the interface or implementation, so they must be mapped + back to the original polymorphic types for annotation purposes. + + This table contains the mappings. Its format is: + key = generated type name + value = (original type name, + original number of parameters) + + For example, if we have the generated output: + type 'a t = ... + type _1 = int t + Then the idea is, in the reader and writer functions, instead of using + _1 in the annotation, we use _ t. The entry in original_types would be: + ("_1", ("t", 1)) + + (The alternate strategy of actually producing a definition for type _1 + aliasing int t in the implementation doesn't work, because the annotations + will disagree with the interface in the case of recursive types.) +*) +type original_types = (string, string * int) Hashtbl.t + + (* Format of the table: key = type name (without arguments) @@ -226,10 +252,13 @@ let add_annot (x : type_expr) a : type_expr = Atd_ast.map_annot (fun a0 -> Atd_annot.merge (a @ a0)) x -let expand ?(keep_poly = false) (l : type_def list) : type_def list = +let expand ?(keep_poly = false) (l : type_def list) + : type_def list * original_types = let seqnum, tbl = init_table () in + let original_types = Hashtbl.create 16 in + let rec subst env (t : type_expr) : type_expr = match t with `Sum (loc, vl, a) -> @@ -331,6 +360,8 @@ let expand ?(keep_poly = false) (l : type_def list) : type_def list = (* Create entry in the table, indicating that we are working on it *) Hashtbl.add tbl name (i, n_param, None, None); + Hashtbl.add original_types name (orig_name, List.length orig_args); + (* Get the original type definition *) let (_, n, orig_opt_td, new_opt_td) = try Hashtbl.find tbl orig_name @@ -479,7 +510,7 @@ let expand ?(keep_poly = false) (l : type_def list) : type_def list = ) tbl [] in let l = List.sort (fun (i, _) (j, _) -> compare i j) l in - List.map snd l + (List.map snd l, original_types) @@ -515,7 +546,7 @@ let replace_type_names (subst : string -> string) (t : type_expr) : type_expr = let standardize_type_names - ~prefix (l : type_def list) : type_def list = + ~prefix ~original_types (l : type_def list) : type_def list = let new_id = let n = ref 0 in @@ -542,6 +573,13 @@ let standardize_type_names assert (is_special k); let k' = new_id tbl in Hashtbl.add tbl k k'; + begin try + let orig_info = Hashtbl.find original_types k in + Hashtbl.remove original_types k; + Hashtbl.add original_types k' orig_info + with Not_found -> + assert false (* Must have been added during expand *) + end; k' in let l = @@ -562,9 +600,9 @@ let standardize_type_names let expand_module_body ?(prefix = "_") ?keep_poly ?(debug = false) l = let td_list = List.map (function `Type td -> td) l in - let td_list = expand ?keep_poly td_list in + let (td_list, original_types) = expand ?keep_poly td_list in let td_list = if debug then td_list - else standardize_type_names ~prefix td_list + else standardize_type_names ~prefix ~original_types td_list in - List.map (fun td -> `Type td) td_list + (List.map (fun td -> `Type td) td_list, original_types) diff --git a/atd_expand.mli b/atd_expand.mli index ed5578b..34e387a 100644 --- a/atd_expand.mli +++ b/atd_expand.mli @@ -2,11 +2,22 @@ (** Monomorphization of type definitions *) +type original_types = (string, string * int) Hashtbl.t +(** To support the generation of annotations for types that are created + during the monomorphization process, a mapping must be kept connecting + the monomorphic type name to the original polymorphic one, including its + original number of parameters. + + This table is only used in producing those annotations to support the + Atdgen command line option -o-name-overlap. It can probably be ignored + for most uses of expand_module_body. +*) + val expand_module_body : ?prefix:string -> ?keep_poly:bool -> ?debug:bool -> - Atd_ast.module_body -> Atd_ast.module_body + Atd_ast.module_body -> Atd_ast.module_body * original_types (** Monomorphization of type expressions. diff --git a/atd_util.ml b/atd_util.ml index c2de4ec..9b7261a 100644 --- a/atd_util.ml +++ b/atd_util.ml @@ -17,11 +17,11 @@ let read_lexbuf else body in - let body = + let (body, original_types) = if expand then Atd_expand.expand_module_body ?keep_poly ~debug: xdebug body - else body + else (body, Hashtbl.create 0) in - head, body + ((head, body), original_types) let read_channel ?expand ?keep_poly ?xdebug ?inherit_fields ?inherit_variants diff --git a/atd_util.mli b/atd_util.mli index c81bab6..655ea43 100644 --- a/atd_util.mli +++ b/atd_util.mli @@ -10,10 +10,16 @@ val read_lexbuf : ?inherit_variants:bool -> ?pos_fname:string -> ?pos_lnum:int -> - Lexing.lexbuf -> Atd_ast.full_module + Lexing.lexbuf -> Atd_ast.full_module * Atd_expand.original_types (** Read an ATD file from a lexbuf. See also [read_channel], [load_file] and [load_string]. + If expand is true, the second part of the return value will contain + a hash table mapping the types generated during monomorphization back + to their original polymorphic types. See {!Atd_expand.original_types} + for more information about this table. If expand is false, the value + will be the empty hash table. + @param expand Perform monomorphization by creating specialized type definitions starting with an underscore. @@ -56,7 +62,7 @@ val read_channel : ?inherit_variants:bool -> ?pos_fname:string -> ?pos_lnum:int -> - in_channel -> Atd_ast.full_module + in_channel -> Atd_ast.full_module * Atd_expand.original_types (** Read an ATD file from an [in_channel]. Options: see [read_lexbuf]. The default [pos_fname] is set to ["<stdin>"] when appropriate. *) @@ -68,7 +74,7 @@ val load_file : ?inherit_variants:bool -> ?pos_fname:string -> ?pos_lnum:int -> - string -> Atd_ast.full_module + string -> Atd_ast.full_module * Atd_expand.original_types (** Read an ATD file. Options: see [read_lexbuf]. The default [pos_fname] is the given input file name. *) @@ -80,7 +86,7 @@ val load_string : ?inherit_variants:bool -> ?pos_fname:string -> ?pos_lnum:int -> - string -> Atd_ast.full_module + string -> Atd_ast.full_module * Atd_expand.original_types (** Read ATD data from a string. Options: see [read_lexbuf]. *) val tsort : diff --git a/atdcat.ml b/atdcat.ml index 669ef9a..37383ff 100644 --- a/atdcat.ml +++ b/atdcat.ml @@ -56,8 +56,10 @@ let parse let l = List.map ( fun file -> - Atd_util.load_file ~expand ~keep_poly ~xdebug - ~inherit_fields ~inherit_variants file + fst ( + Atd_util.load_file ~expand ~keep_poly ~xdebug + ~inherit_fields ~inherit_variants file + ) ) files in let heads, bodies = List.split l in @@ -132,7 +134,7 @@ let () = where the contents are formatted as HTML using <p>, <code> and <pre>. This is suitable input for \"caml2html -ext html:cat\" - which allows to convert ATD files into HTML."; + which converts ATD files into HTML."; "-strip", Arg.String (fun s -> strip_sections := split_on_comma s @ !strip_sections), diff --git a/manual/atd-body.mlx b/manual/atd-body.mlx index d37322c..8f34aec 100644 --- a/manual/atd-body.mlx +++ b/manual/atd-body.mlx @@ -3,7 +3,9 @@ ## #use "topfind";; #require "caml2html";; -#require "atd";; +#require "easy-format";; +#directory "..";; +#load "atd.cma";; #require "unix";; #use "../atd_version.ml";; #use "macros.ml";; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-atd.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