Commits

camlspotter committed 44bba19

not good... recursion things

Comments (0)

Files changed (6)

 -------------
 
 - Added (partial) polymorphic variant and object type support
+
 - Removed Address.t, since it just complicates the code base.
   Tree addresses must be handled by the tree data themselves.
+
+- Removed (: Leftovers :) annotation. Use mc_leftovers special type instead.
+
+- [t mc_leftovers] can live with more than one conv()s. 
+  [t mc_leftovers] works as leftover fields only for a conv(type) with the same
+  syntactic target type. For example, [Json.t mc_leftovers] works as leftover field
+  for conv(json), but not for conv(ocaml).
+
 - Bug fixes
 
 0.10.0

json/tests/test.ml

 end
 
 module Test6 = struct
-  type t = { x : int; y : float; rest (:Leftovers:) : Json.t mc_fields; } with conv (json)
+  type t = { x : int; y : float; rest : Json.t mc_leftovers; } with conv (json)
   type t' = { x' as "x" : int; y' as "y" : float; z' as "z" : unit  } with conv (json)
   
   let () = 
     assert (t_of_json (json_of_t v) = `Ok v)
 end
 
+module Test8 = struct
+
+  type t = Foo 
+
+  and ts = t list with conv(json)
+
+end
+
+module Test9 = struct
+
+  type t = { x : int }
+
+  and ts = t list with conv(json)
+
+end

pa/pa_meta_conv.ml

       optional : bool;
       leftovers : bool }
 
-let interprete_record_field_annotation loc id ctyp = 
+let interprete_record_field_annotation target_type_path loc id ctyp = 
   let name = name_of_ident id  in
   let optional = match ctyp with
     | <:ctyp< $_$ mc_option >>
     | _ -> false
   in
   let leftovers = match ctyp with
-    | <:ctyp< $_$ mc_leftovers >> -> true
+    | <:ctyp< $id:id$ mc_leftovers >> -> 
+        (* Leftover is only enabled for conv(a) where a = target_type_path *)
+        same_idents target_type_path id
     | _ -> false
   in
   let annots = 
   let st0 = { name; optional; leftovers } in
   List.fold_left (fun st -> function
     | <:expr< $str:x$ >> -> { st with name = x }
-    | <:expr< Leftovers >> -> { st with leftovers = true }
     | _ -> prerr_endline "Unknown (: .. :) meta_conv annotation"; assert false) st0 annots
 
 (* code generators ******************************************************)
     (* let _annot = interprete_type_name_annotation tyd_loc name in *)
     let fields, rest = List.fold_right (fun (loc, lab_id, ctyp) (fields, rest) ->
       let f = gen_ctyp (strip_field_flags ctyp) in
-      let sem = interprete_record_field_annotation loc lab_id ctyp in
+      let sem = interprete_record_field_annotation target_type_path loc lab_id ctyp in
       match sem with
       | { leftovers = true; _ } ->
           fields, Some <:expr< __value#$name_of_ident lab_id$ >>
     let _annot = interprete_type_name_annotation tyd_loc name in
     let fields, rest = List.fold_right (fun (loc, lab_id, ctyp) (fields, rest) ->
       let f = gen_ctyp (strip_field_flags ctyp) in
-      let sem = interprete_record_field_annotation loc lab_id ctyp in
+      let sem = interprete_record_field_annotation target_type_path loc lab_id ctyp in
       match sem with
       | { leftovers = true; _ } ->
           fields, Some <:expr< __value.$id:lab_id$ >>
     let annot = interprete_type_name_annotation tyd_loc name in
     *)
     let labels, fields, rest = List.fold_right (fun (loc, lab_id, ctyp) (labs, st, rest) ->
-      let sem = interprete_record_field_annotation loc lab_id ctyp in
+      let sem = interprete_record_field_annotation target_type_path loc lab_id ctyp in
       let ctyp = strip_field_flags ctyp in
       match sem with
       | { leftovers = true; _ }-> 
   let record tyd_loc name params _loc field_types = 
     let annot = interprete_type_name_annotation tyd_loc name in
     let labels, fields, rest = List.fold_right (fun (loc, lab_id, ctyp) (labs, st, rest) ->
-      let sem = interprete_record_field_annotation loc lab_id ctyp in
+      let sem = interprete_record_field_annotation target_type_path loc lab_id ctyp in
       let ctyp = strip_field_flags ctyp in
       match sem with
       | { leftovers = true; _ }-> 
     in
       
     let decoder = 
-      [ `NoRec <:binding<
+      [ `MayRec <:binding<
           $lid: name ^ "_of_" ^ A.conv_name$ : $func_type params name$ = fun x ->
           $lid: "meta_" ^ name ^ "_of_" ^ A.conv_name$ $the_record$ x
           >>;  
   | IdUid (_, name) | IdLid (_, name) -> name
   | _ -> assert false
 
+let strip_locs_of_ident id =
+  let rec f = function
+    | IdAcc (_, id1, id2) -> IdAcc (_loc, f id1, f id2)
+    | IdApp (_, id1, id2) -> IdApp (_loc, f id1, f id2)
+    | IdLid (_, s) -> IdLid (_loc, s)
+    | IdUid (_, s) -> IdUid (_loc, s)
+    | IdAnt _ -> assert false
+  in
+  f id
 
+let same_idents id1 id2 = strip_locs_of_ident id1 = strip_locs_of_ident id2
 
 (** { 6 Tvars } *)
 
 (** [expr_of_id id] and [patt_of_id id] create an expr or patt of [id] correspondingly *)
 
 
+val strip_locs_of_ident : ident -> ident
+(** strips off location information to normalize [ident] *)
+
+val same_idents : ident -> ident -> bool
+(** returns true if two idents are the same, ignoring the locations *)
 
 (** { 6 Tvars } *)
 

pa/tests/test_rest.ml

-type t = { a : int; b : float; c (: Leftovers :) : (string * Json.t) list  } with conv(json)
+type t = { a : int; b : float; c : Json.t mc_leftovers } with conv(json)
 
 type t = { d : int; e : Json.t mc_leftovers } with conv(json)