OK, TDNR working correctly this time

parser-typechecker/src/Unison/FileParsers.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-# Language OverloadedStrings #-}
 {-# Language ScopedTypeVariables #-}
 {-# Language UnicodeSyntax     #-}
@@ -5,16 +6,15 @@
 
 module Unison.FileParsers where
 
-import           Control.Monad.State (evalStateT)
+import           Control.Monad.State (runStateT, evalStateT)
 import           Data.ByteString (ByteString)
 import           Data.Bytes.Put (runPutS)
 import qualified Data.Foldable as Foldable
-import           Data.Functor.Identity (runIdentity)
+import           Data.Functor.Identity (runIdentity, Identity(..))
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe
 import qualified Data.Text as Text
-import           Data.Tuple (swap)
 import qualified Unison.Builtin as B
 import qualified Unison.Codecs as Codecs
 import           Unison.DataDeclaration (DataDeclaration')
@@ -66,7 +66,7 @@ synthesizeFile unisonFile
                                 dataDeclaration
                                 effectDeclaration
                                 unqualifiedLookup
-      n = Typechecker.synthesizeAndResolve env0 term
+      n = Typechecker.synthesizeAndResolve env0
       die s h = error $ "unknown " ++ s ++ " reference " ++ show h
       typeOf r =
         pure . fromMaybe (error $ "unknown reference " ++ show r)
@@ -85,8 +85,9 @@ synthesizeFile unisonFile
           )
         )
         B.builtinTypedTerms
+      (Result notes mayType, newTerm) = runIdentity $ runStateT n term
     in
-      swap <$> runIdentity n
+      Result notes ((newTerm,) <$> mayType)
 
 synthesizeUnisonFile :: Var v
                      => UnisonFile v

parser-typechecker/src/Unison/Typechecker.hs

@@ -159,9 +159,9 @@ resolvable _ = False
 synthesizeAndResolve
   :: (Monad f, Var v, Ord loc)
   => Env f v loc
-  -> Term v loc
   -> TDNR f v loc (Type v loc)
-synthesizeAndResolve env t = do
+synthesizeAndResolve env = do
+  t <- get
   r1 <- lift $ synthesize env t
   typeDirectedNameResolution r1 env
 
@@ -192,8 +192,7 @@ typeDirectedNameResolution resultSoFar env = do
       in if goAgain
             then do
               traverse_ substSuggestion res2
-              newTerm <- get
-              synthesizeAndResolve env newTerm
+              synthesizeAndResolve env
             else
               -- The type hasn't changed
               let Result ns _ = suggest res2