experiment: compress idl using eta contraction

src/mo_idl/mo_to_idl.ml

@@ -25,7 +25,28 @@ module MakeState() = struct
         then c else '_'
       ) name
 
-  let monomorphize_con vs c =
+  let eta_contract c =
+    match Cons.kind c with
+    | Def (tbs, Con(d, ts)) ->
+      let rec check_ts n tbs ts =
+        match tbs, ts with
+        | [], [] -> true
+        | _ :: tbs0, Var (_, j) :: ts0 ->
+           n = j && check_ts (n+1) tbs0 ts0
+        | _ -> false
+      in
+      if check_ts 0 tbs ts
+      then Some d
+      else None
+    | _ -> None
+
+  let rec eta_norm c =
+    match eta_contract c with
+    | Some d -> eta_norm d
+    | None -> c
+
+  let monomorphize_con vs c0 =
+    let c = eta_norm c0 in
     let name = normalize_name (Cons.name c) in
     match Cons.kind c with
     | Def _ ->
@@ -84,9 +105,10 @@ module MakeState() = struct
     | Prim p -> prim p
     | Var (s, i) -> assert false
     | Con (c, ts) ->
+       let c = eta_norm c in
        (match Cons.kind c with
         | Def (_, t) ->
-           (match (open_ ts t) with
+           (match normalize (open_ ts t) with
             | Prim p -> prim p
             | Any -> I.PrimT I.Reserved
             | Non -> I.PrimT I.Empty

test/mo-idl/issue-4309.mo

@@ -7,16 +7,45 @@ actor {
   module Inner {
     public type Foo = Types.Foo;
     public type Credit<T> = Nat;
+    public type Binary<T, U> = (T, U);
+    public type Ternary<T, U, V> = (T, U, V);
+    public type BinaryInv<T, U> = Binary<U, T>;
+    public type TernaryInv<T, U, V> = Ternary<V, U, T>;
   };
 
   module Innerer {
       public type Credit<T> = Inner.Credit<T>;
+      public type Binary<T,U> = Inner.Binary<T,U>;
+      public type BinaryInv<T, U> = Inner.BinaryInv<T, U>;
+      public type Ternary<T, U, V> = Inner.Ternary<T, U, V >;
+      public type TernaryInv<T,U, V> = Inner.TernaryInv<T, U, V >;
   };
 
   public type Credit = Innerer.Credit<Nat>;
   public type Foo = Inner.Foo;
+
+  public type Binary = Innerer.Binary<Nat, Int>;
+  public type Ternary = Innerer.Ternary<Nat, Int, Bool>;
+
   public func get() : async (Credit, Inner.Credit<Nat>, Innerer.Credit<Nat>) {
       (0, 0, 0)
   };
-  public func silly(_ : Foo, _ : Inner.Foo, _ : Types.Foo, _ : Types2.Foo) : async () { }
+  public func silly(_ : Foo, _ : Inner.Foo, _ : Types.Foo, _ : Types2.Foo) : async () { };
+
+  public func binary() : async (Binary, Inner.Binary<Nat, Int>, Innerer.Binary<Nat, Int>) {
+      loop {};
+  };
+
+  public func ternary() : async (Ternary, Inner.Ternary<Nat, Int, Bool>, Innerer.Ternary<Nat, Int, Bool>) {
+      loop {};
+  };
+
+  public func binaryInv() : async (Binary, Inner.BinaryInv<Nat, Int>, Innerer.BinaryInv<Nat, Int>) {
+      loop {};
+  };
+
+  public func ternaryInv() : async (Ternary, Inner.TernaryInv<Nat, Int, Bool>, Innerer.TernaryInv<Nat, Int, Bool>) {
+      loop {};
+  };
+
 }

test/mo-idl/ok/issue-2529.did.ok

@@ -1,19 +1,19 @@
-type Version = variant {Version: nat;};
-type Mode = 
+type Version_3 = variant {Version: nat;};
+type Mode_3 = 
  variant {
    Alphanumeric;
    EightBit;
    Kanji;
    Numeric;
  };
-type ErrorCorrection = 
+type ErrorCorrection_3 = 
  variant {
    H;
    L;
    M;
    Q;
  };
 service : {
-  encode: (version: Version, level: ErrorCorrection, mode: Mode, "text":
-   text) -> (text);
+  encode: (version: Version_3, level: ErrorCorrection_3, mode: Mode_3,
+   "text": text) -> (text);
 }

test/mo-idl/ok/issue-4309.did.ok

@@ -1,10 +1,42 @@
-type Foo__2 = variant {bla;};
-type Foo__1 = variant {bla;};
+type Ternary__1 = 
+ record {
+   nat;
+   int;
+   bool;
+ };
+type TernaryInv = 
+ record {
+   bool;
+   int;
+   nat;
+ };
+type Ternary = 
+ record {
+   nat;
+   int;
+   bool;
+ };
 type Foo = variant {bla;};
-type Credit__2 = nat;
-type Credit__1 = nat;
-type Credit = nat;
+type Binary__1 = 
+ record {
+   nat;
+   int;
+ };
+type BinaryInv = 
+ record {
+   int;
+   nat;
+ };
+type Binary = 
+ record {
+   nat;
+   int;
+ };
 service : {
-  get: () -> (Credit, Credit__1, Credit__2);
-  silly: (Foo, Foo__1, Foo__2, Foo__2) -> ();
+  binary: () -> (Binary, Binary__1, Binary__1);
+  binaryInv: () -> (Binary, BinaryInv, BinaryInv);
+  get: () -> (nat, nat, nat);
+  silly: (Foo, Foo, Foo, Foo) -> ();
+  ternary: () -> (Ternary, Ternary__1, Ternary__1);
+  ternaryInv: () -> (Ternary, TernaryInv, TernaryInv);
 }

test/mo-idl/ok/keyword.did.ok

@@ -1,4 +1,3 @@
-type record_ = nat;
 service : {
-  "record": ("record": record_) -> ();
+  "record": ("record": nat) -> ();
 }

test/mo-idl/ok/prelude.did.ok

@@ -1,6 +1,4 @@
-type Text = null;
 type Nat = null;
-type Id = int;
 service : {
-  f: (x: Nat, y: Text) -> (Id);
+  f: (x: Nat, y: Nat) -> (int);
 }