[BUG] Incorrect compilation of polyvar pattern matching

[Ngoguey42]

Describe the bug
In the following code, the incorrect and correct functions have the same OCaml semantic. They however don't output the same result.

type test = [ `B | `C | `D | `A ]

let print (tag : test) =
  match tag with
  | `A -> Firebug.console##log ("`A", tag)
  | `B -> Firebug.console##log ("`B", tag)
  | `C -> Firebug.console##log ("`C", tag)
  | `D -> Firebug.console##log ("`D", tag)

let correct x y =
  let z =
    match x, y with
    | (`A, v) | (v, `A) -> v
    | `B, _ | _, `B -> `B
    | `C, _ | _, `C -> `C
    | `D, `D -> `D
  in
  z

let incorrect x y =
  match x, y with
  | (`A, v) | (v, `A) -> v
  | `B, _ | _, `B -> `B
  | `C, _ | _, `C -> `C
  | `D, `D -> `D

let () =
  let a = `C in
  Printf.printf "[a] is:\n%!";
  print a;

  let b = `A in
  Printf.printf "[b] is:\n%!";
  print b;

  let c = correct a b in
  Printf.printf "[correct a b] is:\n%!";
  print c;

  let d = incorrect a b in
  Printf.printf "[incorrect a b] is:\n%!";
  print d;

  Firebug.console##log (Js.Unsafe.meth_call correct "toString" [| |]);
  Firebug.console##log (Js.Unsafe.meth_call incorrect "toString" [| |])

[a] is:
[0, '`C', 67]

[b] is:
[0, '`A', 65]

[correct a b] is:
[0, '`C', 67]

[incorrect a b] is:
[0, '`B', 66]

function correct(x, y){
     /*<<bin/icon.ml:71:2>>*/ var switch$0 = 0;
    if(typeof x === "number")
     if(65 === x){
      var v = y;
      switch$0 = 2;
     }
     else if(68 === x && typeof y === "number" && 68 === y){var z = 68; switch$0 = 1;}
    var switch$1 = 0;
    switch(switch$0){
      case 0:
       var switch$2 = 0;
       if(typeof y === "number")
        if(65 === y){
         var v = x;
         switch$1 = 1;
        }
        else if(66 === y) switch$2 = 2; else switch$2 = 1;
       else
        switch$2 = 1;
       var switch$3 = 0;
       switch(switch$2){
         case 0: break;
         case 1:
          var switch$4 = 0;
          if(typeof x === "number")
           if(66 === x){switch$3 = 1; switch$4 = 1;} else 67 === x;
          if(! switch$4) var z = 67;
          break;
         default: switch$3 = 1;
       }
       if(switch$3) var z = 66;
       break;
      case 2:
       switch$1 = 1; break;
    }
    if(switch$1) var z = v;
     /*<<bin/icon.ml:78:2>>*/ return z;
    /*<<bin/icon.ml:78:3>>*/ }

function incorrect(x, y){
     /*<<bin/icon.ml:81:2>>*/ var switch$0 = 0;
    if(typeof x === "number")
     if(65 === x){
      var v = y;
      switch$0 = 1;
     }
     else if(68 === x && typeof y === "number" && 68 === y)
       /*<<bin/icon.ml:85:14>>*/ return 68;
    if(! switch$0){
     var switch$1 = 0;
     if(typeof y === "number")
      if(65 === y){var v = x; switch$1 = 2;} else if(66 === y) switch$1 = 1;
     switch(switch$1){
       case 0:
        var switch$2 = 0;
        if(typeof x === "number") if(66 === x) switch$2 = 1; else 67 === x;
        if(! switch$2)  /*<<bin/icon.ml:84:21>>*/ return 67;
        break;
       case 2: break;
     }
      /*<<bin/icon.ml:83:21>>*/ return 66;
    }
     /*<<bin/icon.ml:82:25>>*/ return v;
    /*<<bin/icon.ml:85:16>>*/ }

Versions
ocaml 5.0.0, jsoo 5.2.0, dune 3.8.1

Compiled this way:

(env
  (dev     (flags (-w +1..3+5..28+30..39+43+46..47+49..57+61..62-40-26 -strict-sequence -strict-formats -short-paths -keep-locs -g)))
  (release (flags (-w +1..3+5..28+30..39+43+46..47+49..57+61..62-40-26 -strict-sequence -strict-formats -short-paths -keep-locs   )))
)

(executable
 (name frontend)
 (modes js)
 (js_of_ocaml
  (flags --pretty --debug-info --source-map-inline --sourcemap)
  )
 (libraries
  ...stuff...)
 (modules
 ...stuff...)
 (preprocess
  (pps ...stuff...)))

[Ngoguey42]

Same with JSOO 5.3.0

[hhugo]

Thanks for the report, I was able to reproduce with ocaml 5 (I'm surprised I don't see --enable effects in your flags.

your example seem to give the correct result with ocaml 4.14.

I suspect the issue comes from the cps transformation. @vouillon, can you take a look ?

[Ngoguey42]

I'll add --enable effects. Thanks

[hhugo]

I'll add --enable effects. Thanks

No need. I got confused. My explanation doesn't make sense. I'll look at it again

[hhugo]

For information,

• The issue is not specific to pattern matching and polyvar.
• The correct and incorrect functions are both affects by the issue in OCaml 5 with the right flags. (no inline, no pretty, ..)
• The issue was probably introduced in #1342 (js_of_ocaml 5.0.0)
• It is not clear if the ocaml compiler < 5 is able to emit the problematic control flow

[hhugo]

Fix included in the 5.4.0 release