Conversion to camlp5 AST fail for polyvariants

CHANGES

@@ -1,5 +1,8 @@
-# Ureleased
+## Ureleased
 
+## Changed 
+
+* Fix issue 32: using polyvariants as type arguments crashed for Camlp5
 
 ## 0.5.3 (2024-07-30)
 

camlp5/Camlp5Helpers.ml

@@ -21,6 +21,7 @@
 open GTCommon
 open Ploc
 open MLast
+let failwiths = HelpersBase.failwiths
 
 module Located = struct
   type t = Ploc.t
@@ -142,7 +143,7 @@ module Exp = struct
     | "[]" | "::" | _ when HelpersBase.Char.is_alpha s.[0] && capitalized s -> <:expr< $uid:s$ >>
     | _ -> <:expr< $lid:s$ >>
 
-  let attribute _ e = e 
+  let attribute _ e = e
   let unit ~loc =  <:expr< () >>
   let sprintf ~loc fmt =
     Printf.ksprintf (fun s -> <:expr< $lid:s$ >>) fmt
@@ -312,7 +313,7 @@ module Typ = struct
     let init = List.hd r in
     List.fold_left (fun acc x -> arrow ~loc x acc) init (List.tl r)
 
-  let from_caml root_typ =
+  let rec from_caml root_typ =
     let rec helper typ =
       let loc = loc_from_caml typ.Ppxlib.ptyp_loc in
       match typ.ptyp_desc with
@@ -321,21 +322,24 @@ module Typ = struct
       | Ptyp_arrow (lab, l, r) -> arrow ~loc (helper l) (helper r)
       | Ptyp_constr ({txt;_}, ts) -> constr ~loc txt (List.map helper ts)
       | Ptyp_tuple ts -> <:ctyp< ( $list:(List.map helper ts)$ ) >>
-      | Ptyp_variant (_,_,_)
-      | _ -> failwith "Not implemented: conversion from OCaml ast to Camlp5 Ast"
+      | Ptyp_variant (cs, flg, None) ->
+          variant ~loc ~is_open:(match flg with Closed -> false | Open -> true) cs
+      | Ptyp_variant (_,_,Some _ )
+      | _ ->
+        failwiths "Not implemented: conversion from OCaml AST to Camlp5 AST (%s %d)" __FILE__ __LINE__
     in
     helper root_typ
 
   (* this might need to be changed *)
-  let variant ~loc ?(is_open=false) fs =
+  and variant ~loc ?(is_open=false) fs =
     let vs = fs |> List.map (fun rf -> match rf.Ppxlib.prf_desc with
         | Ppxlib.Rinherit core_typ -> PvInh (loc, from_caml core_typ)
         | Rtag (lb, is_open, args) ->
           PvTag (loc, VaVal lb.txt, VaVal is_open, VaVal (List.map from_caml args), <:vala< [] >> )
       ) in
     if is_open
     then <:ctyp< [ > $list:vs$ ] >>
-    else <:ctyp< [ < $list:vs$ ] >>
+    else <:ctyp< [ = $list:vs$ ] >>
 
   let variant_of_t ~loc typ =
     <:ctyp< [ > $list:[PvInh (loc, typ)]$ ] >>

regression/dune.tests

@@ -400,6 +400,17 @@
   (preprocess (action (run %{project_root}/camlp5/pp5+gt+plugins+dump.exe %{input-file})))
   (preprocessor_deps (file %{project_root}/camlp5/pp5+gt+plugins+dump.exe)))
 
+(cram
+  (applies_to test084)
+  (deps test084.exe))
+(executable
+  (name test084)
+  (modules test084)
+  ;(flags (:standard -dsource))
+  (libraries GT)
+  (preprocess (action (run %{project_root}/camlp5/pp5+gt+plugins+dump.exe %{input-file})))
+  (preprocessor_deps (file %{project_root}/camlp5/pp5+gt+plugins+dump.exe)))
+
 (cram
   (applies_to test086)
   (deps test086std.exe))

regression/test084.ml

@@ -0,0 +1,10 @@
+let id x = x
+
+module PV : sig
+  @type ('a,'b)  pv = [ `A of 'a | `B of 'b * GT.int ] GT.list with show
+end = struct
+  @type ('a,'b)  pv = [ `A of 'a | `B of 'b * GT.int ] GT.list with show
+end
+
+let () =
+  print_endline @@ (GT.show PV.pv (GT.show GT.int) (GT.show GT.int)) [`A 5]

regression/test084.t

@@ -0,0 +1,2 @@
+  $ ./test084.exe
+  [`A (5)]