Update to OCADml and OSCADml Gg adoption

commit ebc2fc0 Author: Geoff deRosenroll <[email protected]> Date: Tue Jan 24 17:10:57 2023 -0800 Add changes entry and update dependencies commit dec9e9a Author: Geoff deRosenroll <[email protected]> Date: Tue Jan 24 12:23:19 2023 -0800 Adjust to OCADml adopting abstract Gg vec types
OCADml · Jan 26, 2023 · 6dc3a2a · 6dc3a2a
1 parent 5ce65c2
commit 6dc3a2a
Show file tree

Hide file tree

Showing 6 changed files with 47 additions and 30 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,3 +1,8 @@
+## v0.2.0
+
+- adjust to additional type parameter of `Scad.t` in OSCADml `v0.2.0`
+- add cases to catch `gg` vector type identifiers (OCADml `v0.3.0`)
+
 ## v0.1.0
 
 - Initial opam release of `ppx_deriving_cad`
diff --git a/dune-project b/dune-project
@@ -29,11 +29,15 @@
     :with-test))
   (OCADml
    (and
-    (>= 0.1.0)
+    (>= 0.3.0)
     :with-test))
   (OSCADml
    (and
-    (>= 0.1.0)
+    (>= 0.2.0)
+    :with-test))
+  (gg
+   (and
+    (>= 1.0.0)
     :with-test))
   (ppxlib
    (>= 0.22.2))

diff --git a/ppx_deriving_cad.opam b/ppx_deriving_cad.opam
@@ -15,8 +15,9 @@ depends: [
   "dune" {>= "3.2"}
   "ocaml" {>= "4.14.0"}
   "base" {>= "0.14.1" & with-test}
-  "OCADml" {>= "0.1.0" & with-test}
-  "OSCADml" {>= "0.1.0" & with-test}
+  "OCADml" {>= "0.3.0" & with-test}
+  "OSCADml" {>= "0.2.0" & with-test}
+  "gg" {>= "1.0.0" & with-test}
   "ppxlib" {>= "0.22.2"}
   "ppx_inline_test" {with-test}
   "odoc" {with-doc}

diff --git a/src/dim.ml b/src/dim.ml
@@ -4,7 +4,7 @@ open! Ast_builder.Default
 type t =
   | D2
   | D3
-  | Poly of string * string * string
+  | Poly of string * string * string * string
 
 type error =
   | MixedDimensions
@@ -48,10 +48,10 @@ let rec check ~loc dim = function
   | [%type: OCADml.Poly2.t]
   | [%type: Bezier2.t]
   | [%type: OCADml.Bezier2.t]
-  | [%type: (V2.t, float, Affine2.t) Scad.t]
-  | [%type: (v2, float, Affine2.t) Scad.t]
-  | [%type: (OCADml.V2.t, float, OCADml.Affine2.t) OCADml.Scad.t]
-  | [%type: (OCADml.v2, float, OCADml.Affine2.t) OCADml.Scad.t]
+  | [%type: ([ `D2 ], V2.t, float, Affine2.t) Scad.t]
+  | [%type: ([ `D2 ], v2, float, Affine2.t) Scad.t]
+  | [%type: ([ `D2 ], OCADml.V2.t, float, OCADml.Affine2.t) OCADml.Scad.t]
+  | [%type: ([ `D2 ], OCADml.v2, float, OCADml.Affine2.t) OCADml.Scad.t]
   | [%type: Scad.d2]
   | [%type: OSCADml.Scad.d2] ->
     ( match dim with
@@ -70,31 +70,36 @@ let rec check ~loc dim = function
   | [%type: OCADml.Bezier3.t]
   | [%type: Mesh.t]
   | [%type: OCADml.Mesh.t]
-  | [%type: (V3.t, V3.t, Affine3.t) Scad.t]
-  | [%type: (v3, v3, Affine3.t) Scad.t]
-  | [%type: (OCADml.V3.t, OCADml.V3.t, OCADml.Affine3.t) OSCADml.Scad.t]
-  | [%type: (OCADml.v3, OCADml.v3, OCADml.Affine3.t) OSCADml.Scad.t]
+  | [%type: ([ `D3 ], V3.t, V3.t, Affine3.t) Scad.t]
+  | [%type: ([ `D3 ], v3, v3, Affine3.t) Scad.t]
+  | [%type: ([ `D3 ], OCADml.V3.t, OCADml.V3.t, OCADml.Affine3.t) OSCADml.Scad.t]
+  | [%type: ([ `D3 ], OCADml.v3, OCADml.v3, OCADml.Affine3.t) OSCADml.Scad.t]
   | [%type: Scad.d3]
   | [%type: OSCADml.Scad.d3] ->
     ( match dim with
     | Some D2 -> Error MixedDimensions
     | Some (Poly _) -> Error PolyCollapse
     | _ -> Ok (Some D3) )
   | [%type:
-      ( [%t? { ptyp_desc = Ptyp_var s; _ }]
+      ( [%t? { ptyp_desc = Ptyp_var d; _ }]
+      , [%t? { ptyp_desc = Ptyp_var s; _ }]
       , [%t? { ptyp_desc = Ptyp_var r; _ }]
       , [%t? { ptyp_desc = Ptyp_var a; _ }] )
       Scad.t]
   | [%type:
-      ( [%t? { ptyp_desc = Ptyp_var s; _ }]
+      ( [%t? { ptyp_desc = Ptyp_var d; _ }]
+      , [%t? { ptyp_desc = Ptyp_var s; _ }]
       , [%t? { ptyp_desc = Ptyp_var r; _ }]
       , [%t? { ptyp_desc = Ptyp_var a; _ }] )
       OSCADml.Scad.t] ->
     ( match dim with
     | Some (D2 | D3) -> Error PolyCollapse
-    | Some (Poly (s', r', a')) as d
-      when String.equal s s' && String.equal r r' && String.equal a a' -> Ok d
-    | None -> Ok (Some (Poly (s, r, a)))
+    | Some (Poly (d', s', r', a')) as dim
+      when String.equal d d'
+           && String.equal s s'
+           && String.equal r r'
+           && String.equal a a' -> Ok dim
+    | None -> Ok (Some (Poly (d, s, r, a)))
     | _ -> Error PolyMismatch )
   | { ptyp_desc = Ptyp_tuple (hd :: cts); _ } ->
     let f dim' ct =

diff --git a/src/ppx_deriving_cad.ml b/src/ppx_deriving_cad.ml
@@ -105,14 +105,16 @@ let transform_expr ~loc ~jane ~transform ~kind (ct : core_type) =
         aux attrs (Util.list_map_expr :: funcs) typ
       | [%type: ([%t? typ], [%t? _]) result] | [%type: ([%t? typ], [%t? _]) Result.t] ->
         aux attrs (Util.result_map_expr :: funcs) typ
-      | [%type: ([%t? _], [%t? _], [%t? _]) Scad.t]
+      | [%type: ([%t? _], [%t? _], [%t? _], [%t? _]) Scad.t]
       | [%type: Scad.d2]
       | [%type: Scad.d3]
-      | [%type: ([%t? _], [%t? _], [%t? _]) OSCADml.Scad.t]
+      | [%type: ([%t? _], [%t? _], [%t? _], [%t? _]) OSCADml.Scad.t]
       | [%type: OSCADml.Scad.d2]
       | [%type: OSCADml.Scad.d3] -> inner_expr attrs (fix_id "OSCADml" "Scad"), funcs
-      | [%type: v2] | [%type: OCADml.v2] -> inner_expr attrs (fix_id "OCADml" "V2"), funcs
-      | [%type: v3] | [%type: OCADml.v3] -> inner_expr attrs (fix_id "OCADml" "V3"), funcs
+      | [%type: v2] | [%type: OCADml.v2] | [%type: GG.v2] | [%type: GG.V2.t] ->
+        inner_expr attrs (fix_id "OCADml" "V2"), funcs
+      | [%type: v3] | [%type: OCADml.v3] | [%type: GG.v3] | [%type: GG.V3.t] ->
+        inner_expr attrs (fix_id "OCADml" "V3"), funcs
       | { ptyp_desc = Ptyp_tuple cts; _ } ->
         let tup_expr =
           let argn n = Printf.sprintf "arg%i" n in
@@ -244,7 +246,7 @@ let transformer_intf ~ctxt (_rec_flag, type_declarations) =
         , cad_type_arrow ~lbl:(Optional "about") ~loc "V3"
         , cad_type_arrow ~loc "Affine3"
         , transforms_3d )
-      | Poly (space, rot, affine) ->
+      | Poly (_, space, rot, affine) ->
         ( var_type_arrow ~loc space
         , var_type_arrow ~loc rot
         , var_type_arrow ~lbl:(Optional "about") ~loc space

diff --git a/test/ppx_deriving_scad_test.ml b/test/ppx_deriving_scad_test.ml
@@ -33,15 +33,15 @@ module type FunType = sig
 end
 
 module PolyScads : sig
-  type ('s, 'r, 'a) t =
-    { a : ('s, 'r, 'a) Scad.t
-    ; b : ('s, 'r, 'a) Scad.t
+  type ('d, 's, 'r, 'a) t =
+    { a : ('d, 's, 'r, 'a) Scad.t
+    ; b : ('d, 's, 'r, 'a) Scad.t
     }
   [@@deriving cad]
 end = struct
-  type ('s, 'r, 'a) t =
-    { a : ('s, 'r, 'a) Scad.t
-    ; b : ('s, 'r, 'a) Scad.t
+  type ('d, 's, 'r, 'a) t =
+    { a : ('d, 's, 'r, 'a) Scad.t
+    ; b : ('d, 's, 'r, 'a) Scad.t
     }
   [@@deriving cad]
 end
@@ -141,7 +141,7 @@ let%test "rotate_about_pair" =
   let a = { reg = v3 5. 5. 0.; unit = v3 0. 1. 0. }
   and r = v3 0. 0. (Float.pi /. 2.)
   and p = v3 0. 5. 0. in
-  let rot = zrot_vec_pair ~about:p r.z a in
+  let rot = zrot_vec_pair ~about:p (V3.z r) a in
   V3.equal rot.reg (V3.rotate ~about:p r a.reg) && V3.equal rot.unit (V3.rotate r a.unit)
 
 let%test "unit_prevents_translate" =