From f949c5cde29b24089b1e28dd99f065e9330ebcac Mon Sep 17 00:00:00 2001
From: Paul IANNETTA <paul.iannetta@ens-lyon.fr>
Date: Mon, 29 Jun 2015 13:51:38 +0200
Subject: [PATCH] last changes
---
generator/attributes.ml | 16 ++++++++++++----
generator/js_of_ast.ml | 36 ++++++++++++++++++++++++++++++++++--
generator/parse_type.ml | 2 +-
3 files changed, 47 insertions(+), 7 deletions(-)
diff --git a/generator/attributes.ml b/generator/attributes.ml
index 8cf35d8..b6ab348 100644
--- a/generator/attributes.ml
+++ b/generator/attributes.ml
@@ -3,13 +3,21 @@ open Parsetree
open Typedtree
open Mytools
-let rec extract_cstr_attrs (cstr : Typedtree.constructor_declaration) : string * string list =
+let rec extract_cstr_attrs (cstr : Typedtree.constructor_declaration) =
let cstr_name = Ident.name cstr.cd_id in
- let cstr_params = cstr.cd_attributes
- |> List.map (fun (_, pl) -> extract_payload pl)
- |> List.flatten
+ let cstr_params = extract_attrs cstr.cd_attributes
in (cstr_name, cstr_params)
+and extract_vb_attrs (vb : Typedtree.value_binding) =
+ extract_attrs vb.vb_attributes
+
+and extract_attrs attrs =
+ attrs
+ |> List.map extract_attr
+ |> List.flatten
+
+and extract_attr (_, pl) = extract_payload pl
+
and extract_payload = function
| PStr s -> extract_structure s
| PTyp _ -> error "Type found. A tuple or a single value was expected"
diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index 6dc52c5..d997aa5 100644
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -110,11 +110,38 @@ let ppf_single_cstrs typ =
let ppf_multiple_cstrs typ rest =
Format.sprintf "{type: \"%s\", %s}"
typ rest
+
+(**
+ * Log Part
+ *)
+
+module Log :
+sig
+ val status : unit -> bool
+ val init_log : unit -> unit
+ val toggle : string -> unit
+end
+ =
+struct
+ let s = ref false
+
+ let status () = !s
+ let init_log () = s := false
+ let toggle update = match update with
+ | "logged" -> s := true;
+ | "unlogged" -> s := false;
+ | _ -> ();
+end
(**
* Main part
*)
-
+
+(*let to_javascript typedtree =
+ js_of_structure typedtree
+(** + Log related post processing **)
+*)
+
let rec show_value_binding vb =
js_of_let_pattern vb.vb_pat vb.vb_expr
@@ -145,7 +172,12 @@ and js_of_structure_item s = match s.str_desc with
| Tstr_class _ -> out_of_scope "objects"
| Tstr_class_type _ -> out_of_scope "class types"
| Tstr_include _ -> out_of_scope "includes"
- | Tstr_attribute _ -> out_of_scope "attributes"
+ | Tstr_attribute attrs ->
+ let log_status =
+ match extract_attr attrs with
+ | [] -> ""
+ | x :: xs -> x
+ in Log.toggle log_status; ""
and js_of_branch b obj =
let spat, binders = js_of_pattern b.c_lhs obj in
diff --git a/generator/parse_type.ml b/generator/parse_type.ml
index b00a50c..1f0b31a 100644
--- a/generator/parse_type.ml
+++ b/generator/parse_type.ml
@@ -29,7 +29,7 @@ let initial_env () =
then Env.open_pers_signature "Stdlib" Env.initial_unsafe_string
else Env.open_pers_signature "Stdlib" Env.initial_unsafe_string
with Not_found ->
- fatal_error "cannot open pervasives"
+ fatal_error "cannot open stdlib"
(** Optionally preprocess a source file *)
let preprocess sourcefile =
--
GitLab