[MLton] Bug in monomorphise(?)

[Vesa Karvonen]

Attempt to compile the program (which uses stuff from mltonlib)

(* <--- test.mlb *)
local
   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
   $(MLTON_LIB)/com/ssh/generic/unstable/lib-with-default.mlb

   test.sml
in
end
(* ---> *)

(* <--- test.sml *)
val () = let
   open Generic
in
   app (println o Word.toString o hash largeInt)
       [12345678910,
        12345678911,
        11987654321]
end
(* ---> *)

with latest MLton from the trunk, produces the following compiler
output (-verbose 2 -type-check true):

MLton starting
MLton MLTONVERSION (built Tue Jul 03 22:53:10 2007 on grape)
  created this file on Wed Jul 04 11:16:54 2007.
Do not edit this file.
Flag settings:
   align: 4
   atMLtons: (test, @MLton, --)
   chunk: chunk per function
   codegen: x86
   contifyIntoMain: false
   debug: false
   defaultChar: char8
   defaultWideChar: widechar32
   defaultInt: int32
   defaultReal: real64
   defaultWord: word32
   diag passes: []
   drop passes: []
   elaborate allowConstant (default): false
   elaborate allowConstant (enabled): true
   elaborate allowFFI (default): false
   elaborate allowFFI (enabled): true
   elaborate allowPrim (default): false
   elaborate allowPrim (enabled): true
   elaborate allowOverload (default): false
   elaborate allowOverload (enabled): true
   elaborate allowRebindEquals (default): false
   elaborate allowRebindEquals (enabled): true
   elaborate deadCode (default): false
   elaborate deadCode (enabled): true
   elaborate forceUsed (default): false
   elaborate forceUsed (enabled): true
   elaborate ffiStr (default):
   elaborate ffiStr (enabled): true
   elaborate nonexhaustiveExnMatch (default): default
   elaborate nonexhaustiveExnMatch (enabled): true
   elaborate nonexhaustiveMatch (default): warn
   elaborate nonexhaustiveMatch (enabled): true
   elaborate redundantMatch (default): warn
   elaborate redundantMatch (enabled): true
   elaborate sequenceNonUnit (default): warn
   elaborate sequenceNonUnit (enabled): true
   elaborate warnUnused (default): false
   elaborate warnUnused (enabled): true
   elaborate only: false
   export header: None
   exn history: false
   gc check: Limit
   indentation: 3
   inline: NonRecursive {product = 320, small = 60}
   inlineIntoMain: true
   input file: test
   keep Machine: false
   keep RSSA: false
   keep SSA: false
   keep SSA2: false
   keep def use: true
   keep dot: false
   keep passes: []
   extra_: false
   lib dir: /home/vk/work/sml/mlton/install/usr/lib/mlton
   lib target dir: /home/vk/work/sml/mlton/install/usr/lib/mlton/self
   loop passes: 1
   mark cards: true
   max function size: 10000
   mlb path maps:
[/home/vk/work/sml/mlton/install/usr/lib/mlton/mlb-path-map,
/home/vk/.mlton/mlb-path-map]
   native commented: 0
   native live stack: false
   native optimize: 1
   native move hoist: true
   native copy prop: true
   native copy prop cutoff: 1000
   native cutoff: 100
   native live transfer: 8
   native shuffle: true
   native ieee fp: false
   native split: Some 20000
   optimizationPassesSet: [<ssa2PassesSet>, <ssaPassesSet>,
<sxmlPassesSet>, <xmlPassesSet>]
   polyvariance: Some {rounds = 2, small = 30, product = 300}
   prefer abs paths: true
   prof passes: []
   profile: None
   profile branch: false
   profile C: []
   profile IL: ProfileSource
   profile include/exclude: [(Seq [Star [.], Or [Seq [Seq [[$], [(],
[S], [M], [L], [_], [L], [I], [B], [)]]]], Star [.]], false)]
   profile raise: false
   profile stack: false
   profile val: false
   show basis: None
   show def-use: None
   show types: false
   ssaPassesSet: <ssaPassesSet>
   ssaPasses: [default]
   ssa2PassesSet: <ssa2PassesSet>
   ssa2Passes: [default]
   sxmlPassesSet: <sxmlPassesSet>
   sxmlPasses: [default]
   target: self
   target arch: X86
   target OS: Linux
   type check: true
   verbosity: Pass
   warn unrecognized annotation: true
   xmlPassesSet: <xmlPassesSet>
   xmlPasses: [default]
   zone cut depth: 100
   Compile SML starting
      pre codegen starting
	 parseAndElaborate starting
	 parseAndElaborate finished in 5.48 + 3.42 (38% GC)
	 deadCode starting
	 deadCode finished in 0.05 + 0.00 (0% GC)
	 defunctorize starting
	 defunctorize finished in 0.52 + 0.98 (66% GC)
	 typeCheck starting
	    typeCheck starting
	    typeCheck finished in 0.23 + 0.00 (0% GC)
	 typeCheck finished in 0.23 + 0.00 (0% GC)
	 xmlSimplify starting
	    typeCheck starting
	    typeCheck finished in 0.22 + 0.00 (0% GC)
	    xmlShrink starting
	    xmlShrink finished in 0.21 + 0.26 (55% GC)
	    typeCheck starting
	       typeCheck starting
	       typeCheck finished in 0.18 + 0.00 (0% GC)
	    typeCheck finished in 0.18 + 0.00 (0% GC)
	    xmlSimplifyTypes starting
	    xmlSimplifyTypes finished in 0.09 + 0.00 (0% GC)
	    typeCheck starting
	       typeCheck starting
	       typeCheck finished in 0.20 + 0.00 (0% GC)
	    typeCheck finished in 0.20 + 0.00 (0% GC)
	    typeCheck starting
	    typeCheck finished in 0.20 + 0.00 (0% GC)
	 xmlSimplify finished in 1.10 + 0.26 (19% GC)
	 typeCheck starting
	    typeCheck starting
	    typeCheck finished in 0.20 + 0.00 (0% GC)
	 typeCheck finished in 0.20 + 0.00 (0% GC)
	 monomorphise starting
	 monomorphise finished in 0.26 + 0.23 (47% GC)
	 typeCheck starting
	    typeCheck starting
Type error: type mismatch
(list_0 * Sum.sum_0 -> bool * Lazy.status_0 ref ref)
* (WithTypeInfo.s_0
   * ((Sum.sum_0 * Sum.sum_0 -> bool)
      * ((Sum.sum_0 * Sum.sum_0 -> Primitive.Order.t_0)
	 * ((unit -> Sum.sum_0)
	    * ((Sum.sum_0 * Sum.sum_0 -> bool)
	       * ((Sum.sum_0 * Sum.sum_0 -> Primitive.Order.t_0)
		  * ((unit -> Sum.sum_0)
		     * (WithArbitrary.t_0
			* ((Sum.sum_0 -> word32 * word32 -> word32 -> word32)
			   * unit)))))))))
-> word32
(list_0 * Sum.sum_0 -> bool * Lazy.status_0 ref ref)
* (WithTypeInfo.s_0
   * ((Sum.sum_0 * Sum.sum_0 -> bool)
      * ((Sum.sum_0 * Sum.sum_0 -> Primitive.Order.t_0)
	 * ((unit -> Sum.sum_0)
	    * (WithArbitrary.t_0
	       * ((Sum.sum_0 -> word32 * word32 -> word32 -> word32) * unit))))))
-> word32
val x_0 =
   x_1
val x_0 =
   x_1
let
<--- Rest of long output snipped --->

-Vesa Karvonen