Fix bug in monomorphisation

OCamlPro · Mar 8, 2019 · 39a203b · 39a203b
1 parent 276299a
commit 39a203b
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 5 deletions.
diff --git a/tools/liquidity/liquidFromParsetree.ml b/tools/liquidity/liquidFromParsetree.ml
@@ -31,7 +31,7 @@ let ident_counter = ref 0
 let minimal_version = 0.9
 
 (* The maximal version of liquidity files that are accepted by this compiler *)
-let maximal_version = 1.0
+let maximal_version = 1.01
 
 
 open Asttypes

diff --git a/tools/liquidity/liquidInfer.ml b/tools/liquidity/liquidInfer.ml
@@ -585,8 +585,10 @@ let rec type_name = function
   | Tlambda (ty1, ty2) -> (type_name ty1) ^ (type_name ty2)
   | Tclosure ((ty1, ty2), ty3) ->
     "C" ^ (type_name ty1) ^ (type_name ty2) ^ (type_name ty3)
-  | Trecord (rn, _) -> "R" ^ rn
-  | Tsum (sn, _) -> "A" ^ sn
+  | Trecord (rn, l) ->
+    String.concat "" (["R"; rn] @ List.map (fun (f, t) -> f ^ type_name t) l)
+  | Tsum (sn, l) ->
+    String.concat "" (["A"; sn] @ List.map (fun (f, t) -> f ^ type_name t) l)
   | Tcontract c ->
     begin match c.sig_name with Some n -> "CN" ^ n | None -> "CU" end
   | Tvar { contents = a }  -> "v" ^ !a.id

diff --git a/tools/liquidity/liquidToParsetree.ml b/tools/liquidity/liquidToParsetree.ml
@@ -8,7 +8,7 @@
 (**************************************************************************)
 
 (* The version that will be required to compile the generated files. *)
-let output_version = "1.0"
+let output_version = "1.01"
 
 open Asttypes
 open Longident
@@ -112,6 +112,10 @@ let list_caml_abbrevs_in_order () =
   |> List.map (fun (ty, (s, caml_ty, _)) -> s, caml_ty, ty)
 
 let rec convert_type ~abbrev ?name ty =
+  let params =
+    LiquidTypes.free_tvars ty
+    |> StringSet.elements
+    |> List.map (fun v -> Typ.var v) in
   match ty with
   | Ttez ->  typ_constr "tez" []
   | Tunit -> typ_constr "unit" []
@@ -134,7 +138,7 @@ let rec convert_type ~abbrev ?name ty =
         let subst = LiquidTypes.build_subst known_ty ty in
         List.map (fun (_, t) -> convert_type ~abbrev t)
           (StringMap.bindings subst)
-      with Not_found -> [] in
+      with Not_found -> params in
     typ_constr name args
   | Tcontract contract_sig -> convert_contract_sig ~abbrev contract_sig
   | Tvar { contents = { contents = { id; tyo = None | Some Tpartial _ }}} ->