diff --git a/generator/attributes.ml b/generator/attributes.ml index 8cf35d87b6fce19b109a984c56a66b060dc9a5a1..b6ab348ff5a535971c52670d054ed7a1767bb979 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 6dc52c57aa9d4de325c256986d95a20fefbfad08..d997aa5c19f75ac0f7604e5f895d817e7faca5f7 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 b00a50c3bfe48b13def67e6f232d7799013156fb..1f0b31a4c1f70dace2f265edae68a4057100ba1d 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 =