diff --git a/generator/attributes.ml b/generator/attributes.ml index 55ef5bc0a5546f573919b2153b6b3c558ef91fd1..372f114bff098e1b3333eb9d241c1b3cb3634650 100644 --- a/generator/attributes.ml +++ b/generator/attributes.ml @@ -4,6 +4,12 @@ open Typedtree open Types open Mytools +let builtin_attributes = + [("::", ["head"; "tail"])] + +let ident_builtin_attributes = + List.map (fun (fst, snd) -> (List.assoc fst Predef.builtin_idents), snd) builtin_attributes + let rec extract_attrs attrs = attrs |> List.map extract_attr @@ -84,10 +90,9 @@ and extract_constant = function | Const_int64 _ -> error "A string or a char was expected but a int64 was found" | Const_nativeint _ -> error "A string or a char was expected but a nativeint was found" -let extract_cstr_attrs (cstr : constructor_declaration) = - let cstr_name = Ident.name cstr.cd_id in - let cstr_params = extract_attrs cstr.cd_attributes - in (cstr_name, cstr_params) +let fetch_builtin_attrs (cstr : constructor_description) = + List.assoc cstr.cstr_name builtin_attributes -let extract_vb_attrs (vb : Typedtree.value_binding) = - extract_attrs vb.vb_attributes +let extract_cstr_attrs (cstr : constructor_description) = + try fetch_builtin_attrs cstr + with Not_found -> extract_attrs cstr.cstr_attributes diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml index ac7d80004044d0fef762e02e378f3bda960d68a0..9f1526e0080289d3f337903fc373da7ed252a885 100644 --- a/generator/js_of_ast.ml +++ b/generator/js_of_ast.ml @@ -63,8 +63,8 @@ let is_infix f args = match args with let args_loc = (x.exp_loc.loc_start, x.exp_loc.loc_end) in if fst args_loc < fst f_loc then true else false -let map_cstr_fields ?loc f cstr elements = - let fields = extract_attrs cstr.cstr_attributes in +let map_cstr_fields ?loc f (cstr : constructor_description) elements = + let fields = extract_cstr_attrs cstr in try List.map2 f fields elements with Invalid_argument _ -> error ?loc ("Insufficient fieldnames for arguments to " ^ cstr.cstr_name) diff --git a/generator/main.ml b/generator/main.ml index 0cf54c56ae1120d0048e5fa29cf9d1da24bff909..bbe8fdce8daba862436780f3b30a8eabf95a25eb 100644 --- a/generator/main.ml +++ b/generator/main.ml @@ -14,10 +14,6 @@ let outputfile = ref None (*#########################################################################*) let _ = - - (* disable loading of stdlib *) - Clflags.nopervasives := false; - (*---------------------------------------------------*) (* parsing of command line *) diff --git a/generator/parse_type.ml b/generator/parse_type.ml index a834891ee8ae77919dcef575ebbfb58c35960b2d..fb1620898fde47a56872a03a47f6a037b3be773a 100644 --- a/generator/parse_type.ml +++ b/generator/parse_type.ml @@ -25,9 +25,8 @@ let init_path () = let initial_env () = try - if !Clflags.nopervasives - then Env.open_pers_signature "Stdlib" Env.initial_unsafe_string - else Env.open_pers_signature "Stdlib" Env.initial_unsafe_string + let env = Env.initial_unsafe_string in + Env.open_pers_signature "Stdlib" env with Not_found -> fatal_error "cannot open stdlib" diff --git a/generator/stdlib_ml/stdlib.mli b/generator/stdlib_ml/stdlib.mli index 3b90020cfd556b2ba7c3ad6d39eaeb32e967cb7f..544791d60b50f2ccc1be050aa323910955def66c 100644 --- a/generator/stdlib_ml/stdlib.mli +++ b/generator/stdlib_ml/stdlib.mli @@ -1,7 +1,5 @@ -(* Following type definition for lists hardcoded into OCaml/generator: -type 'a list = -| [] -| :: [@f head, tail] of 'a * 'a list +(* +Field name attributes for builtins (eg: ::) are defined in attributes.ml *) (* Custom pair type *)