Commits

camlspotter  committed a62d186 Merge

merge with default

  • Participants
  • Parent commits 44bba19, df4599b
  • Branches dev

Comments (0)

Files changed (7)

File lib/internal.ml

     val variant : string -> t list -> t
     val poly_variant : string -> t list -> t
     val record : (string * t) list -> t
+    val object_ : (string * t) list -> t
   end
 
   module Decode : sig
     val variant : t -> string * t list
     val poly_variant : t -> string * t list
     val record  : t -> (string * t) list
+    val object_ : t -> (string * t) list
   end
 end
 

File lib/internal.mli

     val variant : string -> t list -> t
     val poly_variant : string -> t list -> t
     val record  : (string * t) list -> t
+    val object_ : (string * t) list -> t
   end
 
   module Decode : sig
     val variant : t -> string * t list
     val poly_variant : t -> string * t list
     val record  : t -> (string * t) list
+    val object_ : t -> (string * t) list
   end
 end
 

File ocaml/ocaml.ml

   | Variant of string * t list
   | Poly_variant of string * t list
   | Record of (string * t) list
+  | Object of (string * t) list
   | Tuple of t list
   | Unit
 
   | Poly_variant (tag, []) -> fprintf ppf "`%s" tag
   | Poly_variant (tag, ts) -> fprintf ppf "@[<2>`%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
   | Record fields -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
+  | Object fields -> fprintf ppf "@[<2>object @[%a@] end@]" (format_list "@ " (fun ppf (f, v) -> fprintf ppf "method %s= %a" f format v)) fields
   | Tuple ts -> fprintf ppf "(@[<2>%a@])" (format_list ",@ " format) ts
   | Unit -> fprintf ppf "()"
 

File ocaml/ocaml.mli

   | Variant of string * t list
   | Poly_variant of string * t list
   | Record of (string * t) list
+  | Object of (string * t) list
   | Tuple of t list
   | Unit
 

File ocaml/ocaml_conv.ml

 module Encode = struct
   let tuple ts = Tuple ts
   let variant tag ts = Variant (tag, ts)
-  let poly_variant tag ts = Variant (tag, ts)
+  let poly_variant tag ts = Poly_variant (tag, ts)
   let record fields = Record fields
+  let object_ fields = Object fields
 end
 
 let ocaml_of_unit () = Unit
     | Record alist -> alist
     | _ -> failwith "Record expected for record"
 
+  let object_ = function 
+    | Object alist -> alist
+    | _ -> failwith "Object expected for object"
+
 end
 
 let unit_of_ocaml = function

File ocaml/ocaml_conv.mli

 open Ocaml
 
 module Encode : sig
-  val tuple : t list -> t
+  val tuple   : t list -> t
   val variant : string -> t list -> t
-  val record : (string * t) list -> t
+  val poly_variant : string -> t list -> t
+  val record  : (string * t) list -> t
+  val object_ : (string * t) list -> t
 end
 
 val ocaml_of_unit : unit -> t
 module Decode : sig
   val tuple   : ocaml -> ocaml list
   val variant : ocaml -> string * ocaml list
+  val poly_variant : ocaml -> string * ocaml list
   val record  : ocaml -> (string * ocaml) list
+  val object_ : ocaml -> (string * ocaml) list
 end
 
 val unit_of_ocaml : unit decoder

File pa/pa_meta_conv.ml

          (create_param_type params name)
          <:ctyp< $id:target_type_path$ >>)
 
-(*
-  let func_object_type params fields = 
-    create_for_all params 
-      (dispatch_type params 
-         (create_object_type true (List.map (fun (_loc, id, ctyp) -> 
-           name_of_ident id, strip_field_flags ctyp) fields))
-         <:ctyp< $id:target_type_path$ >>)
-*)
-  
   let dcl _loc name (params : ctyp list) exp =
     <:binding<
       $lid: A.conv_name ^ "_of_" ^ name$ : $func_type params name$ = 
         $Gen.abstract _loc (List.map patt_of_tvar params) exp$
     >>
   
-(*
-  let dcl_object _loc name (params : ctyp list) fields exp =
-    <:binding<
-      $lid: A.conv_name ^ "_of_" ^ name ^ "_object"$ : $func_object_type params fields$ = 
-        $Gen.abstract _loc (List.map patt_of_tvar params) exp$
-    >>
-*)
-  
   let rec gen_ctyp : ctyp -> expr = function
     | TyId (loc, id) ->  (* int *)
         <:expr@loc< $id: change_id (fun s -> A.conv_name ^ "_of_" ^ s) id$ >>
     <:expr< fun __value -> 
         let __name = $str:name$ in
         let valid_labels = $labels$ in
-        let fields = $id:module_path$.Decode.record __value in 
+        let fields = $id:module_path$.Decode.object_ __value in 
         let unknown_fields = Meta_conv.Internal.filter_record_fields valid_labels fields in
         let __f = $the_object$ in
         $unknown_fields_check$ __name __value unknown_fields (fun () ->