From e4049dc5a66f3956f5dde7d9ba44e5680bd48fb4 Mon Sep 17 00:00:00 2001
From: Cesar Roux Dit Buisson <cr1013@imperial.ac.uk>
Date: Fri, 4 Sep 2015 13:59:51 +0100
Subject: [PATCH] Fix recursive type definition
js_of_structure_item now goes through the entire list provided by Tstr_type tl. An example of recursive module use also included (tests/types.ml)
---
generator/Makefile | 2 +-
generator/js_of_ast.ml | 13 +++++--------
generator/tests/calc.ml | 2 +-
generator/tests/types.ml | 7 +++++++
4 files changed, 14 insertions(+), 10 deletions(-)
create mode 100644 generator/tests/types.ml
diff --git a/generator/Makefile b/generator/Makefile
index 454c45a..0dc8c27 100644
--- a/generator/Makefile
+++ b/generator/Makefile
@@ -33,7 +33,7 @@ stdlib:
%.inferred.mli:
$(OCAMLBUILD) $@
- cp _build/%@ .
+ cp _build/$@ .
tests: main.byte stdlib
#TODO: Remove the first line
diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index 96b44d2..b422028 100755
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -327,20 +327,17 @@ and js_of_structure_item ?(mod_gen=[]) old_env s =
| Tstr_eval (e, _) -> Printf.sprintf "%s" @@ js_of_expression ~mod_gen new_env e
| Tstr_value (_, vb_l) -> String.concat "@,@," @@ List.map (fun vb -> show_value_binding ~mod_gen vb) @@ vb_l
| Tstr_type tl ->
- let explore_type = function
- | [] -> ()
- | x :: xs ->
- (match x.typ_kind with
+ let create_type x =
+ (match x.typ_kind with
| Ttype_variant cdl ->
let cl = List.map (fun cstr -> extract_cstr_attrs cstr) cdl in
List.iter (fun (name, cstrs_name) -> add_type mod_gen name cstrs_name) cl;
- () (*print_type_tbl ()*)
+ (* print_type_tbl () *)
| Ttype_record ldl ->
(* Beware silent shadowing for record labels *)
List.iter (fun lbl -> Hashtbl.replace record_tbl (Ident.name lbl.ld_id) (Ident.name x.typ_id)) ldl
- | _ -> unsupported "open types, record and abstract type"
- )
- in explore_type tl; ""
+ | _ -> unsupported "open types, record and abstract type")
+ in List.iter create_type tl; ""
| Tstr_open od ->
let name = (fun od -> if od.open_override = Fresh then js_of_longident od.open_txt else "") od in
if name <> "" then
diff --git a/generator/tests/calc.ml b/generator/tests/calc.ml
index a1d45b2..6fb690b 100644
--- a/generator/tests/calc.ml
+++ b/generator/tests/calc.ml
@@ -8,7 +8,7 @@ type expr =
| Div [@f left, right] of expr * expr
| Pop [@f stack] of sexpr
and sexpr =
- | Emp
+ | Emp [@f]
| Push [@f value, stack] of expr * sexpr
let rec eval_ expr = match expr with
diff --git a/generator/tests/types.ml b/generator/tests/types.ml
new file mode 100644
index 0000000..756b588
--- /dev/null
+++ b/generator/tests/types.ml
@@ -0,0 +1,7 @@
+open Calc
+
+type exprone =
+ | Alpha [@f]
+ | Gamma [@f]
+and exprtwo =
+ | Beta [@f]
\ No newline at end of file
--
GitLab