Switch pattern matching order in generated code

[yallop]

Cstubs currently generates code that looks like this

let foreign : type a b. string -> (a -> b) Ctypes.fn -> (a -> b) =
  fun name t -> match name, t with
| "retrieve_INT32_MAX",
  CI.Function (CI.Void, CI.Returns (CI.Primitive CI.Int32_t)) ->
  cstubs_tests_23_retrieve_INT32_MAX
| "retrieve_INT32_MIN",
  CI.Function (CI.Void, CI.Returns (CI.Primitive CI.Int32_t)) ->
  cstubs_tests_22_retrieve_INT32_MIN
| ...

Since the patterns representing the types of foo and bar are the same it's possible in principle for the compiler to merge the branches. At present it doesn't do this, however, and so the destructuring code is repeated in each branch.

(stringswitch name/1121
 case "retrieve_INT32_MAX":
  (switch* t/1122
   case tag 0: (exit 1)
   case tag 1:
    (if (isint (field 0 t/1122))
      (let (match/1321 =a (field 1 t/1122))
        (switch* match/1321
         case tag 0:
          (let (match/1322 =a (field 0 match/1321))
            (switch match/1322
             case tag 0:
              (if (!= (field 0 match/1322) 15) (exit 1)
                (function prim/1251
                  (cstubs_tests_23_retrieve_INT32_MAX
                    prim/1251)))
             default: (exit 1)))
         case tag 1: (exit 1)))
      (exit 1)))
 case "retrieve_INT32_MIN":
  (switch* t/1122
   case tag 0: (exit 1)
   case tag 1:
    (if (isint (field 0 t/1122))
      (let (match/1325 =a (field 1 t/1122))
        (switch* match/1325
         case tag 0:
          (let (match/1326 =a (field 0 match/1325))
            (switch match/1326
             case tag 0:
              (if (!= (field 0 match/1326) 15) (exit 1)
                (function prim/1252
                  (cstubs_tests_22_retrieve_INT32_MIN
                    prim/1252)))
             default: (exit 1)))
         case tag 1: (exit 1)))
      (exit 1)))

We can help the compiler out by changing the generated patterns so that the string appears rightmost :

let foreign : type a b. string -> (a -> b) Ctypes.fn -> (a -> b) =
  fun name t -> match t, name with
| CI.Function (CI.Void, CI.Returns (CI.Primitive CI.Int32_t)),
  "retrieve_INT32_MAX" ->
  cstubs_tests_23_retrieve_INT32_MAX
| CI.Function (CI.Void, CI.Returns (CI.Primitive CI.Int32_t)),
  "retrieve_INT32_MIN" ->
  cstubs_tests_22_retrieve_INT32_MIN,
| ...

Now the branches that destructure the type representation are merged in the generated code:

(switch t/1122 
case tag 0: (exit 1)
case tag 1:
  (if (isint (field 0 t/1122))
    (let (match/1277 (field 1 t/1122))
      (switch match/1277 
      case tag 0:
        (let (match/1278 (field 0 match/1277))
          (switch match/1278 
          ...
          case tag 0:
            (switch (field 0 match/1278) 
            ...
            case int 15:
              (switch name/1121
               case "retrieve_INT32_MAX":
                (closure 
                  (fun camlGenerated_bindings__fun_1328
                    1  prim/1251
                    (cstubs_tests_23_retrieve_INT32_MAX
                      prim/1251)) )
               case "retrieve_INT32_MIN":
                (closure 
                  (fun camlGenerated_bindings__fun_1330
                    1  prim/1252
                    (cstubs_tests_22_retrieve_INT32_MIN
                      prim/1252)) )
               default: (exit 1))

This appears to lead to a significant reduction in code size. For example, the stripped object file for the test-value_printing bindings shrinks from 12K to 8.5K with this change.

We should apply this change to the code generated for function, constant and inverted bindings.

[yallop]

The main cases have been fixed by @orbitz in #355.

PRs that fix the remaining cases for constants and inverted bindings are also welcome!

[yallop]

Fixed by @orbitz (#355, #356).