[MLton-commit] r5320

[Matthew Fluet]

Better debugging.
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2007-02-25 20:45:05 UTC (rev 5319)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun	2007-02-25 20:50:14 UTC (rev 5320)
@@ -236,7 +236,7 @@
       val isSubtype: t * t -> bool =
          fn (t, t') =>
          if not (sameWidth (t, t'))
-            then Error.bug "RepType.Type.isSubtype"
+            then false (* Error.bug "RepType.Type.isSubtype" *)
          else
             (equals (t, t')
              orelse

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun	2007-02-25 20:45:05 UTC (rev 5319)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun	2007-02-25 20:50:14 UTC (rev 5320)
@@ -1445,8 +1445,13 @@
                           | _ => false)
                    | SetSlotExnStack => true
                end
-            fun goto {args: Type.t vector,
-                      dst: Label.t}: bool =
+            val statementOk = 
+               Trace.trace ("Rssa.statementOk",
+                            Statement.layout,
+                            Bool.layout)
+                           statementOk
+            fun gotoOk {args: Type.t vector,
+                        dst: Label.t}: bool =
                let
                   val Block.T {args = formals, kind, ...} = labelBlock dst
                in
@@ -1456,7 +1461,7 @@
                               Kind.Jump => true
                             | _ => false)
                end
-            fun labelIsNullaryJump l = goto {dst = l, args = Vector.new0 ()}
+            fun labelIsNullaryJump l = gotoOk {dst = l, args = Vector.new0 ()}
             fun tailIsOk (caller: Type.t vector option,
                           callee: Type.t vector option): bool =
                case (caller, callee) of
@@ -1584,8 +1589,8 @@
                               end
                          | Goto {args, dst} =>
                               (checkOperands args
-                               ; goto {args = Vector.map (args, Operand.ty),
-                                       dst = dst})
+                               ; gotoOk {args = Vector.map (args, Operand.ty),
+                                         dst = dst})
                          | Raise zs =>
                               (checkOperands zs
                                ; (case raises of
@@ -1606,6 +1611,11 @@
                               Switch.isOk (s, {checkUse = checkOperand,
                                                labelIsOk = labelIsNullaryJump})
                      end
+                  val transferOk =
+                     Trace.trace ("Rssa.transferOk",
+                                  Transfer.layout,
+                                  Bool.layout)
+                     transferOk
                   fun blockOk (Block.T {args, kind, statements, transfer, ...})
                      : bool =
                      let
@@ -1647,6 +1657,11 @@
                      in
                         true
                      end
+                  val blockOk =
+                     Trace.trace ("Rssa.blockOk",
+                                  Block.layout,
+                                  Bool.layout)
+                                 blockOk
 
                   val _ = 
                      Vector.foreach