From dc037afb66ed91a2c99a063c8d346d4b17c45e61 Mon Sep 17 00:00:00 2001
From: Thomas Wood <thomas.wood09@imperial.ac.uk>
Date: Thu, 1 Oct 2015 17:09:03 +0100
Subject: [PATCH] Restore field name overrides for builtin types
---
generator/attributes.ml | 17 +++++++++++------
generator/js_of_ast.ml | 4 ++--
generator/main.ml | 4 ----
generator/parse_type.ml | 5 ++---
generator/stdlib_ml/stdlib.mli | 6 ++----
5 files changed, 17 insertions(+), 19 deletions(-)
diff --git a/generator/attributes.ml b/generator/attributes.ml
index 55ef5bc..372f114 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 ac7d800..9f1526e 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 0cf54c5..bbe8fdc 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 a834891..fb16208 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 3b90020..544791d 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 *)
--
GitLab