[MLton] Bug in defunctorize(?)

[Vesa Karvonen]

Running the

  ./Test.sh

script in the mltonlib (rev 6035) directory

  com/ssh/generic/unstable

produces the following output:

[snipped]
+ mlton -mlb-path-map generated/mlb-path-map -prefer-abs-paths true
-show-def-use generated/test.du -output generated/test -const
'Exn.keepHistory true' -type-check true -verbose 2 test.mlb
MLton starting
MLton MLTONVERSION (built Mon Sep 17 20:44:45 2007 on grape)
  created this file on Wed Sep 19 16:03:22 2007.
Do not edit this file.
Flag settings:
   [snipped]
   Compile SML starting
      pre codegen starting
         parseAndElaborate starting
         parseAndElaborate finished in 7.32 + 4.82 (40% GC)
         deadCode starting
         deadCode finished in 0.08 + 0.00 (0% GC)
         defunctorize starting
         defunctorize finished in 1.40 + 0.97 (41% GC)
         typeCheck starting
            typeCheck starting
Type error: type mismatch
(word32 * word32 -> bool)
* (word32
   * (WithTypeInfo.t
      * (WithDataRecInfo.t
         * ((word32 * (word32 * word32) -> word32)
            * (((HashUniv.t, HashUniv.t) HashTable.hash_table
                * (word32 * word32)
                -> Primitive.Order.t)
               * ((WithPretty.e * word32
                   -> WithPretty.Fixity.t * Prettier.t' Lazy.status ref ref)
                  * (word32 WithArbitrary.t
                     * ((unit -> word32) * (word32 WithPickle.t * unit)))))))))
-> (word32 * word32 -> bool)
   * (word32
      * (WithTypeInfo.t
         * (WithDataRecInfo.t
            * ((word32 * (word32 * word32) -> word32)
               * (((HashUniv.t, HashUniv.t) HashTable.hash_table
                   * (word32 * word32)
                   -> Primitive.Order.t)
                  * ((WithPretty.e * word32
                      -> WithPretty.Fixity.t * Prettier.t' Lazy.status ref ref)
                     * (word32 WithArbitrary.t
                        * ((unit -> word32) * (word32 WithPickle.t *
unit)))))))))
(word32 * word32 -> bool)
* (word32
   * (WithTypeInfo.t
      * (WithDataRecInfo.t
         * ((word32 * (word32 * word32) -> word32)
            * (((HashUniv.t, HashUniv.t) HashTable.hash_table
                * (word32 * word32)
                -> Primitive.Order.t)
               * ((WithPretty.e * word32
                   -> WithPretty.Fixity.t * Prettier.t' Lazy.status ref ref)
                  * unit))))))
-> (word32 * word32 -> bool)
   * (word32
      * (WithTypeInfo.t
         * (WithDataRecInfo.t
            * ((word32 * (word32 * word32) -> word32)
               * (((HashUniv.t, HashUniv.t) HashTable.hash_table
                   * (word32 * word32)
                   -> Primitive.Order.t)
                  * ((WithPretty.e * word32
                      -> WithPretty.Fixity.t * Prettier.t' Lazy.status ref ref)
                     * unit))))))
val x_0 =
   x_1 withAngles
            typeCheck raised in 0.53 + 1.04 (66% GC)
         typeCheck raised in 0.53 + 1.04 (66% GC)
      pre codegen raised in 11.98 + 6.83 (36% GC)
   Compile SML raised in 11.98 + 6.83 (36% GC)
MLton raised in 11.98 + 6.83 (36% GC)
unhandled exception: TypeError

This probably doesn't help much, but the bug seems to be triggered by
the following test code (from test/pretty.sml):

          let
             open BinTree Prettier Pretty Pretty.Fixity
             fun withAngles xP x =
                 xP x >>= (fn (_, d) =>
                 return (ATOMIC, angles d))
          in
             tst (SOME 30)
                 (BinTree.t (mapPrinter withAngles int))
                 "BR\n\
                 \ (BR (LF, <0>, LF),\n\
                 \  <1>,\n\
                 \  BR\n\
                 \   (LF,\n\
                 \    <2>,\n\
                 \    BR (LF, <3>, LF)))"
                 (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
          end

In particular, if you replace the call "(mapPrinter ...)" with "int",
the test will compile.

The code compiles (without modification) with SML/NJ (v110.65) and
produces the expected output.  (I'll write a script for running the
tests with SML/NJ shortly.)

-Vesa Karvonen