unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-05 14:17:33 +03:00
Code Issues Projects Releases Wiki Activity

OK, TDNR working correctly this time

Browse Source
This commit is contained in:
Runar Bjarnason 2018-08-17 21:08:09 -04:00
parent 501d940b99
commit 4b2d8e89de
2 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
parser-typechecker/src/Unison/FileParsers.hs
View File

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

7
parser-typechecker/src/Unison/Typechecker.hs
View File

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