# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1326418659 18000
# Node ID 3cfc79f92db71653cdba2ceb3a2be75bdbb5efc3
# Parent  266814b15dd6616cc6ad1a03e51e6ab94876cfb1
-dumpSource flag; Especialize tweak: may specialize any argument sequence ending in a value of function-containing type

diff -r 266814b15dd6 -r 3cfc79f92db7 src/compiler.sig
--- a/src/compiler.sig	Wed Jan 11 14:52:31 2012 -0500
+++ b/src/compiler.sig	Thu Jan 12 20:37:39 2012 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -185,6 +185,8 @@
     val toSqlify : (string, Cjr.file) transform
 
     val debug : bool ref
+    val dumpSource : bool ref
+
     val doIflow : bool ref
 
     val addPath : string * string -> unit
diff -r 266814b15dd6 -r 3cfc79f92db7 src/compiler.sml
--- a/src/compiler.sml	Wed Jan 11 14:52:31 2012 -0500
+++ b/src/compiler.sml	Thu Jan 12 20:37:39 2012 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -79,8 +79,11 @@
 }
 
 val debug = ref false
+val dumpSource = ref false
 val doIflow = ref false
 
+val doDumpSource = ref (fn () => ())
+
 fun transform (ph : ('src, 'dst) phase) name = {
     func = fn input => let
                   val () = if !debug then
@@ -94,9 +97,15 @@
                   else
                       ();
                   if ErrorMsg.anyErrors () then
-                      NONE
+                      (!doDumpSource ();
+                       doDumpSource := (fn () => ());
+                       NONE)
                   else
-                      SOME v
+                      (if !dumpSource then
+                           doDumpSource := (fn () => Print.eprint (#print ph v))
+                       else
+                           ();
+                       SOME v)
               end,
     print = #print ph,
     time = fn (input, pmap) => let
diff -r 266814b15dd6 -r 3cfc79f92db7 src/especialize.sml
--- a/src/especialize.sml	Wed Jan 11 14:52:31 2012 -0500
+++ b/src/especialize.sml	Thu Jan 12 20:37:39 2012 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -210,13 +210,8 @@
             case #1 e of
                 EAbs (_, _, _, e1) => enterAbs (depth + 1) e1
               | _ => ca depth e
-
-        val n = enterAbs 0 e
     in
-        if n = maxInt then
-            0
-        else
-            n
+        enterAbs 0 e
     end
 
 
@@ -373,18 +368,23 @@
 
                             val loc = ErrorMsg.dummySpan
 
+                            val oldXs = xs
+
                             fun findSplit av (constArgs, xs, typ, fxs, fvs) =
                                 case (#1 typ, xs) of
                                     (TFun (dom, ran), e :: xs') =>
                                     if constArgs > 0 then
-                                        findSplit av (constArgs - 1,
-                                                      xs',
-                                                      ran,
-                                                      e :: fxs,
-                                                      IS.union (fvs, freeVars e))
+                                        if functionInside dom then
+                                            (rev (e :: fxs), xs', IS.union (fvs, freeVars e))
+                                        else
+                                            findSplit av (constArgs - 1,
+                                                          xs',
+                                                          ran,
+                                                          e :: fxs,
+                                                          IS.union (fvs, freeVars e))
                                     else
-                                        (rev fxs, xs, fvs)
-                                  | _ => (rev fxs, xs, fvs)
+                                        ([], oldXs, IS.empty)
+                                  | _ => ([], oldXs, IS.empty)
 
                             val (fxs, xs, fvs) = findSplit true (constArgs, xs, typ, [], IS.empty)
 
diff -r 266814b15dd6 -r 3cfc79f92db7 src/main.mlton.sml
--- a/src/main.mlton.sml	Wed Jan 11 14:52:31 2012 -0500
+++ b/src/main.mlton.sml	Thu Jan 12 20:37:39 2012 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -85,6 +85,9 @@
       | "-dumpTypes" :: rest =>
         (Elaborate.dumpTypes := true;
          doArgs rest)
+      | "-dumpSource" :: rest =>
+        (Compiler.dumpSource := true;
+         doArgs rest)
       | "-output" :: s :: rest =>
         (Settings.setExe (SOME s);
          doArgs rest)
diff -r 266814b15dd6 -r 3cfc79f92db7 src/rpcify.sml
--- a/src/rpcify.sml	Wed Jan 11 14:52:31 2012 -0500
+++ b/src/rpcify.sml	Thu Jan 12 20:37:39 2012 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009, Adam Chlipala
+(* Copyright (c) 2009, 2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -93,6 +93,8 @@
                     case getApp (#1 trans, []) of
                         NONE => (ErrorMsg.errorAt (#2 trans)
                                                   "RPC code doesn't use a named function or transaction";
+                                 (*Print.preface ("Expression",
+                                                CorePrint.p_exp CoreEnv.empty trans);*)
                                  (#1 trans, st))
                       | SOME (n, args) =>
                         case IM.find (tfuncs, n) of