Fix a bug when compiling a trivial loop

Author: minoki

src/cps/inline.sml

@@ -59,7 +59,8 @@ struct
         and goStat (C.Let {decs, cont}, acc) =
               goStat (cont, List.foldl goDec acc decs)
           | goStat (C.App _, acc) = acc
-          | goStat (C.AppCont {applied = _, args}, acc) = args :: acc
+          | goStat (C.AppCont {applied, args}, acc) =
+              if applied = retCont then args :: acc else acc
           | goStat (C.If {cond = _, thenCont, elseCont}, acc) =
               goStat (elseCont, goStat (thenCont, acc))
           | goStat
@@ -1294,6 +1295,12 @@ struct
                                             Syntax.SourceName.merge
                                             (acc, v, TypedSyntax.getVIdName n)
                                       | _ => acc) acc (resultNames, r)
+                                 handle ListPair.UnequalLengths =>
+                                   raise Fail
+                                     ("inliner: number of results mismatch in function application ("
+                                      ^ TypedSyntax.print_VId applied ^ ","
+                                      ^ Int.toString (List.length resultNames)
+                                      ^ "," ^ Int.toString (List.length r) ^ ")")
                              in
                                List.foldl go TypedSyntax.VIdMap.empty results
                              end

test/Makefile

@@ -101,6 +101,7 @@ should_compile += $(addprefix should_compile/,\
   generalization1.sml \
   generalization2.sml \
   record.sml \
+  trivial_loop.sml \
 )
 should_not_compile += $(addprefix should_not_compile/,\
   fixity.sml \

test/should_compile/trivial_loop.sml

@@ -0,0 +1,2 @@
+fun f () = f ();
+f ();