[Pkg-ocaml-maint-commits] [ocaml-atd] 02/08: Imported Upstream version 1.1.0
Stéphane Glondu
glondu at moszumanska.debian.org
Fri Jan 31 10:04:22 UTC 2014
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 <steph at 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
More information about the Pkg-ocaml-maint-commits
mailing list