Commits

Anonymous committed 27855e8

ti_dest -> class ti_dest (for uniformity with cadastr)

Comments (0)

Files changed (1)

         ;
 
 
-        value ti_dest
-         : ti 'o -> #ti (dest 'o)
+        (* todo: вынести dest* в модуль? *)
+
+        class ti_dest ['dest_o]
+          (ti_o : #ti 'o)
+          ()
          =
-         fun ti_o ->
-             let tn_dest = "dest" in
-             let ti_cr_o = ((ti_call_resp ti_o) :> ti _) in
-             let ti_ref_opt_o = new Ref.ti (new Option.ti ti_cr_o ()) () in
-             let ti_dest = new ti_record
+          let tn_dest = "dest" in
+          let ti_cr_o = ((ti_call_resp ti_o) :> ti _) in
+          let ti_ref_opt_o = new Ref.ti (new Option.ti ti_cr_o ()) () in
+
+          object (self : #ti (dest 'o))
+             inherit ti_record ['dest_o]
                ~type_name:(sprintf "dest (%s)" ti_o#type_name)
                ~constr:
                  ( [| (ti_ref_opt_o :> uti) ; (ti_dest_kind :> uti) |]
                    | _ -> assert False
                    ]
                  )
-               & fun [ { dest_ref ; dest_kind } ->
+               ( fun [ { dest_ref ; dest_kind } ->
                          [| ti_field "dest_ref" ti_ref_opt_o dest_ref
                           ; ti_field "dest_kind" ti_dest_kind dest_kind
                           |]
                  ]
-             in
-             let ti_dest = (ti_dest :> ti _) in
-             ( uti_add_meth ti_dest "ser" &
+               )
+             ;
+
+             initializer
+             let self = (self :> ti _) in
+             ( uti_add_meth self "ser" &
                  ubox
-                   (ti_abs ti_dest ti_string)
+                   (ti_abs self ti_string)
                    (fun d ->
                       match d.dest_kind with
                       [ DRemote i tn_o _ _  ->
                           marshal_ser tn_dest (i, tn_o)
                       | DLocal _ _ ->
                           failwith "can't serialize DLocal %s" &
-                            ti_dest#type_name
+                            self#type_name
                       ]
                    )
-             ; uti_add_meth ti_dest "deser" &
+             ; uti_add_meth self "deser" &
                  ubox
-                   (ti_abs ti_string ti_dest)
+                   (ti_abs ti_string self)
                    (fun s ->
                       let (i, tn_o) = marshal_deser tn_dest s in
                       if tn_o <> ti_o#type_name
                           (dest_ubox_get ti_cr_o r)
                       }
                    )
-             ; uti_add_meth ti_dest "is_dest" & ubox ti_unit ()
-             ; ti_dest
-             )
+             ; uti_add_meth self "is_dest" & ubox ti_unit ()
+             ; ()
+             );
+
+          end
         ;