Commits

Anonymous committed 217ce06

records: ti_* and #show

  • Participants
  • Parent commits 9959294

Comments (0)

Files changed (2)

       )
     ~unop_reduce_record:
       (fun fields ->
+         let nfields = Array.length fields in
          let b = Buffer.create 20 in
          let add s = Buffer.add_string b s in
          ( add "{"
-         ; if fields <> [| |]
+         ; if nfields <> 0
            then
-             inner 0
+             ( add " "
+             ; inner 0
+             ; add " "
+             )
              where rec inner i =
-               ( if i > 0
-                 then add " ; "
-                 else ()
-               ; let (field_name, field_res) = fields.(i) in
-                 ( add field_name
-                 ; add " = "
-                 ; add field_res
-                 )
+               if i = nfields
+               then ()
+               else
+                 ( if i > 0
+                   then add " ; "
+                   else ()
+                 ;
+                   let (field_name, field_res) = fields.(i) in
+                   ( add field_name
+                   ; add " = "
+                   ; add field_res
+                   ; inner (i + 1)
+                   )
                )
            else
              ()
 ;
 
 
+value bool_cmp (a : bool) b =
+  match (a, b) with
+  [ (True, True) | (False, False) -> EQ
+  | (False, True) -> LT
+  | (True, False) -> GT
+  ]
+;
+
+value bool_eq (a : bool) b = (a == b)
+;
+
+value bool_hash = fun [ False -> 0 | True -> 1 ]
+;
+
+value bool_show = fun [ False -> "False" | True -> "True" ]
+;
+
+value ti_bool : #tifull bool =
+  new tifull_on_tti
+    ~cmp:bool_cmp
+    ~eq:bool_eq
+    ~hash:bool_hash
+    ~show:bool_show
+    ti_bool__base
+;
+
+
 (*******************)
 
 
 ;
 
 
+class ti_record ['a]
+  ?cmp ?eq ?hash ?show
+  (destr : ('a -> array (field_name * ubox)))
+ =
+  object ((self : #ti 'a) : #ticmp_ 'a)
+
+    inherit ti ['a] ()
+    ;
+
+    method type_desc = Record_type
+      (fun ub ->
+         destr (uget_exn self ub)
+      )
+    ;
+
+    inherit tifull_ops ['a] ?cmp ?eq ?hash ?show ()
+    ;
+
+  end
+;
+
+
+value ti_field fname ti v = (fname, ubox ti v)
+;
+
+
 value ti_variant_dispatch
  : variant_name -> (meth_name -> array ubox) -> _
  = fun vname disp ->
 
 
 
+type my_rec =
+  { f_int : int
+  ; f_string : string
+  ; f_bool : bool
+  }
+;
+
+
+value ti_my_rec =
+ new ti_record
+  (fun [ { f_int ; f_string ; f_bool } ->
+     [| ti_field "f_int" ti_int f_int
+      ; ti_field "f_string" ti_string f_string
+      ; ti_field "f_bool" ti_bool f_bool
+      |] ]
+  )
+;
+
+
+value cdt_test7 () =
+  let test_data =
+    [ ( { f_int = 123 ; f_string = "qwe" ; f_bool = True }
+      , "{ f_int = 123 ; f_string = qwe ; f_bool = True }"
+      )
+    ]
+  in
+    List.iter
+      (fun (arg, expected) ->
+         let got = ti_my_rec#show arg in
+         assert_equal ~printer:(fun x -> x) expected got
+      )
+      test_data
+;
+
+
 value cdt_tests =
   [ "cdt_test1" >:: cdt_test1
   ; "cdt_test2" >:: cdt_test2
   ; "cdt_test4" >:: cdt_test4
   ; "cdt_test5" >:: cdt_test5
   ; "cdt_test6" >:: cdt_test6
+  ; "cdt_test7" >:: cdt_test7
   ]
 ;