Merge pull request #67 from CraigFe/revert-boxed-annotation

Revert "Implement Boxed annotation"

src/repr/type.ml

@@ -58,7 +58,7 @@ let array ?(len = `Int) v = Array { v; len }
 let pair a b = Tuple (Pair (a, b))
 let triple a b c = Tuple (Triple (a, b, c))
 let option a = Option a
-let boxed t = annotate ~add:Type_binary.Boxed.add ~data:() t
+let boxed t = Boxed t
 
 let abstract ~pp ~of_string ~json ~bin ?unboxed_bin ~equal ~compare ~short_hash
     ~pre_hash () =

src/repr/type_binary.ml

@@ -18,12 +18,6 @@ open Type_core
 open Staging
 open Utils
 
-module Boxed = Attribute.Make1 (struct
-  type _ t = unit
-
-  let name = "boxed"
-end)
-
 module Encode = struct
   let chars =
     Array.init 256 (fun i -> Bytes.unsafe_to_string (Bytes.make 1 (Char.chr i)))
@@ -148,6 +142,7 @@ module Encode = struct
     | Custom c -> c.encode_bin
     | Map b -> map ~boxed:true b
     | Prim t -> prim ~boxed:true t
+    | Boxed b -> t b
     | Attributes { attr_type = x; _ } -> t x
     | List l -> list (t l.v) l.len
     | Array a -> array (t a.v) a.len
@@ -162,8 +157,8 @@ module Encode = struct
     | Custom c -> c.unboxed_encode_bin
     | Map b -> map ~boxed:false b
     | Prim t -> prim ~boxed:false t
-    | Attributes { attr_type = x; attrs } -> (
-        match Boxed.find attrs with Some () -> t x | None -> unboxed x)
+    | Boxed b -> t b
+    | Attributes { attr_type = x; _ } -> unboxed x
     | List l -> list (t l.v) l.len
     | Array a -> array (t a.v) a.len
     | Tuple t -> tuple t
@@ -352,6 +347,7 @@ module Decode = struct
     | Custom c -> c.decode_bin
     | Map b -> map ~boxed:true b
     | Prim t -> prim ~boxed:true t
+    | Boxed b -> t b
     | Attributes { attr_type = x; _ } -> t x
     | List l -> list (t l.v) l.len
     | Array a -> array (t a.v) a.len
@@ -366,8 +362,8 @@ module Decode = struct
     | Custom c -> c.unboxed_decode_bin
     | Map b -> map ~boxed:false b
     | Prim t -> prim ~boxed:false t
-    | Attributes { attr_type = x; attrs } -> (
-        match Boxed.find attrs with Some () -> t x | None -> unboxed x)
+    | Boxed b -> t b
+    | Attributes { attr_type = x; _ } -> unboxed x
     | List l -> list (t l.v) l.len
     | Array a -> array (t a.v) a.len
     | Tuple t -> tuple t

src/repr/type_binary.mli

@@ -16,7 +16,6 @@
 
 open Type_core
 open Staging
-module Boxed : Attribute.S1 with type _ t = unit
 
 val encode_bin : 'a t -> 'a encode_bin
 val decode_bin : 'a t -> 'a decode_bin

src/repr/type_core_intf.ml

@@ -30,6 +30,7 @@ module Types = struct
     | Option : 'a t -> 'a option t
     | Record : 'a record -> 'a t
     | Variant : 'a variant -> 'a t
+    | Boxed : 'a t -> 'a t
 
   and 'a len_v = { len : len; v : 'a t }
 

src/repr/type_json.ml

@@ -91,6 +91,7 @@ module Encode = struct
     | Self s -> t s.self_fix
     | Custom _ -> failwith "Unimplemented operation: encode_json"
     | Map b -> map b
+    | Boxed x -> t x
     | Attributes { attr_type = x; attrs } -> (
         match Encode_json.find attrs with None -> t x | Some t -> t)
     | Prim t -> prim t
@@ -301,6 +302,7 @@ module Decode = struct
     | Self s -> t s.self_fix
     | Map b -> map b
     | Prim t -> prim t
+    | Boxed x -> t x
     | Attributes { attr_type = x; attrs } -> (
         match Decode_json.find attrs with None -> t x | Some f -> f)
     | List l -> list (t l.v)

src/repr/type_ordered.ml

@@ -54,6 +54,8 @@ module Refl = struct
     | Variant a, Variant b -> Witness.eq a.vwit b.vwit
     | Var v, _ | _, Var v -> raise (Unbound_type_variable v)
     | Attributes a, Attributes b -> t a.attr_type b.attr_type
+    | Boxed a, b -> t a b
+    | a, Boxed b -> t a b
     | ( ( Map _ | Custom _ | Prim _ | Array _ | List _ | Tuple _ | Option _
         | Record _ | Variant _ | Attributes _ ),
         _ ) ->
@@ -135,6 +137,7 @@ module Equal = struct
     | Custom c -> c.equal
     | Map m -> map m
     | Attributes { attr_type = x; _ } -> t x
+    | Boxed x -> t x
     | Prim p -> prim p
     | List l -> list (t l.v)
     | Array x -> array (t x.v)
@@ -284,6 +287,7 @@ module Compare = struct
     | Self s -> self s
     | Custom c -> c.compare
     | Map m -> map m
+    | Boxed x -> t x
     | Attributes { attr_type = x; _ } -> t x
     | Prim p -> (prim [@inlined]) p
     | List l -> list (t l.v)

src/repr/type_pp.ml

@@ -68,6 +68,7 @@ let dump t =
     | Tuple t -> tuple t ppf x
     | Record r -> record r ppf x
     | Variant v -> variant v ppf x
+    | Boxed t -> aux t ppf x
     | Attributes { attrs; attr_type = t } -> (
         match Attr.find attrs with None -> aux t ppf x | Some pp -> pp ppf x)
   and map : type a b. (a, b) map -> b pp = fun l ppf x -> aux l.x ppf (l.g x)
@@ -166,6 +167,7 @@ let ty : type a. a t Fmt.t =
         Fmt.pf ppf "@[Attributes<%a> (%a)@]"
           Fmt.(list ~sep:semi string)
           names ty t
+    | Boxed b -> Fmt.pf ppf "@[Boxed (%a)@]" ty b
     | Map m -> Fmt.pf ppf "@[Map (%a)@]" ty m.x
     | Prim p -> Fmt.pf ppf "@[%a@]" prim p
     | List l -> Fmt.pf ppf "@[%a list%a@]" ty l.v len l.len

src/repr/type_random.ml

@@ -74,8 +74,8 @@ let rec t : type a. a t -> a random = function
   | Option x -> option x
   | Record x -> record x
   | Variant x -> variant x
-  | Attributes { attr_type; attrs } -> (
-      match Attr.find attrs with None -> t attr_type | Some f -> stage f)
+  | Attributes { attr_type; _ } -> t attr_type
+  | Boxed x -> t x
   | Self x -> stage (fun s -> (* improperly staged *) unstage (t x.self_fix) s)
   | Custom _ -> failwith "Cannot generate random instance of Custom type"
   | Var v -> raise (Unbound_type_variable v)

src/repr/type_size.ml

@@ -107,6 +107,7 @@ let rec t : type a. a t -> a size_of = function
   | Map b -> map ~boxed:true b
   | Prim t -> prim ~boxed:true t
   | Attributes { attr_type; _ } -> t attr_type
+  | Boxed b -> t b
   | List l -> list (t l.v) l.len
   | Array a -> array (t a.v) a.len
   | Tuple t -> tuple t
@@ -121,6 +122,7 @@ and unboxed : type a. a t -> a size_of = function
   | Map b -> map ~boxed:false b
   | Prim t -> prim ~boxed:false t
   | Attributes { attr_type; _ } -> t attr_type
+  | Boxed b -> t b
   | List l -> list (t l.v) l.len
   | Array a -> array (t a.v) a.len
   | Tuple t -> tuple t