mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
remove typecheck function
This commit is contained in:
parent
e7535ab704
commit
01dfa75c0c
@ -1,6 +1,5 @@
|
||||
module Unison.Cli.TypeCheck
|
||||
( typecheck,
|
||||
typecheckFileWithTNDR,
|
||||
( typecheckFileWithTNDR,
|
||||
typecheckFile,
|
||||
typecheckTerm,
|
||||
)
|
||||
@ -8,20 +7,16 @@ where
|
||||
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text qualified as Text
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Codebase (Codebase)
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.FileParsers (parseAndSynthesizeFile, synthesizeFile, synthesizeFileWithTNDR)
|
||||
import Unison.NamesWithHistory (NamesWithHistory (..))
|
||||
import Unison.FileParsers (synthesizeFile, synthesizeFileWithTNDR)
|
||||
import Unison.Parser.Ann (Ann (..))
|
||||
import Unison.Parsers qualified as Parsers
|
||||
import Unison.Prelude
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol (Symbol))
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
@ -29,35 +24,6 @@ import Unison.Typechecker qualified as Typechecker
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
typecheck ::
|
||||
(MonadIO m) =>
|
||||
Codebase IO Symbol Ann ->
|
||||
IO Parser.UniqueName ->
|
||||
[Type Symbol Ann] ->
|
||||
NamesWithHistory ->
|
||||
Text ->
|
||||
(Text, [L.Token L.Lexeme]) ->
|
||||
m
|
||||
( Result.Result
|
||||
(Seq (Result.Note Symbol Ann))
|
||||
(Either (UF.UnisonFile Symbol Ann) (UF.TypecheckedUnisonFile Symbol Ann))
|
||||
)
|
||||
typecheck codebase generateUniqueName ambient names sourceName source = liftIO do
|
||||
uniqueName <- generateUniqueName
|
||||
(Codebase.runTransaction codebase . Result.getResult) do
|
||||
let parsingEnv = Parser.ParsingEnv uniqueName names
|
||||
unisonFile <-
|
||||
Result.fromParsing $
|
||||
Parsers.parseFile (Text.unpack sourceName) (Text.unpack (fst source)) parsingEnv
|
||||
typecheckedUnisonFile <-
|
||||
synthesizeFileWithTNDR ambient (Codebase.typeLookupForDependencies codebase) parsingEnv unisonFile
|
||||
parseAndSynthesizeFile
|
||||
ambient
|
||||
(Codebase.typeLookupForDependencies codebase)
|
||||
(Parser.ParsingEnv uniqueName names)
|
||||
(Text.unpack sourceName)
|
||||
(fst source)
|
||||
|
||||
typecheckFileWithTNDR ::
|
||||
Codebase IO Symbol Ann ->
|
||||
[Type Symbol Ann] ->
|
||||
|
@ -80,14 +80,12 @@ checkFile doc = runMaybeT $ do
|
||||
uniqueName <- liftIO generateUniqueName
|
||||
let parsingEnv = Parser.ParsingEnv uniqueName parseNames
|
||||
(notes, parsedFile, typecheckedFile) <- do
|
||||
let Result.Result parsingNotes maybeParsedFile =
|
||||
Result.fromParsing (Parsers.parseFile (Text.unpack sourceName) (Text.unpack srcText) parsingEnv)
|
||||
case maybeParsedFile of
|
||||
Nothing -> pure (parsingNotes, Nothing, Nothing)
|
||||
Just parsedFile -> do
|
||||
case Result.fromParsing (Parsers.parseFile (Text.unpack sourceName) (Text.unpack srcText) parsingEnv) of
|
||||
Result.Result parsingNotes Nothing -> pure (parsingNotes, Nothing, Nothing)
|
||||
Result.Result _ (Just parsedFile) -> do
|
||||
Result.Result typecheckingNotes maybeTypecheckedFile <-
|
||||
liftIO (Codebase.runTransaction cb (typecheckFileWithTNDR cb ambientAbilities parsingEnv parsedFile))
|
||||
pure (parsingNotes <> typecheckingNotes, Just parsedFile, maybeTypecheckedFile)
|
||||
pure (typecheckingNotes, Just parsedFile, maybeTypecheckedFile)
|
||||
(diagnostics, codeActions) <- lift $ analyseFile fileUri srcText notes
|
||||
let diagnosticRanges =
|
||||
diagnostics
|
||||
|
@ -4,6 +4,7 @@
|
||||
module Unison.Test.LSP (test) where
|
||||
|
||||
import Crypto.Random qualified as Random
|
||||
import Data.Foldable qualified as Foldable
|
||||
import Data.List.Extra (firstJust)
|
||||
import Data.String.Here.Uninterpolated (here)
|
||||
import Data.Text
|
||||
@ -14,6 +15,7 @@ import Unison.ABT qualified as ABT
|
||||
import Unison.Builtin.Decls (unitRef)
|
||||
import Unison.Cli.TypeCheck qualified as Typecheck
|
||||
import Unison.Codebase (Codebase)
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Init qualified as Codebase.Init
|
||||
import Unison.Codebase.SqliteCodebase qualified as SC
|
||||
import Unison.ConstructorReference (GConstructorReference (..))
|
||||
@ -21,12 +23,12 @@ import Unison.LSP.Queries qualified as LSPQ
|
||||
import Unison.Lexer.Pos qualified as Lexer
|
||||
import Unison.Parser.Ann (Ann (..))
|
||||
import Unison.Parser.Ann qualified as Ann
|
||||
import Unison.Parsers qualified as Parsers
|
||||
import Unison.Pattern qualified as Pattern
|
||||
import Unison.Prelude
|
||||
import Unison.Reference qualified as Reference
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type qualified as Type
|
||||
@ -249,9 +251,8 @@ extractCursor txt =
|
||||
makeNodeSelectionTest :: (String, Text, Bool, LSPQ.SourceNode ()) -> Test ()
|
||||
makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $ do
|
||||
(pos, src) <- extractCursor testSrc
|
||||
(notes, mayParsedFile, mayTypecheckedFile) <- typecheckSrc name src
|
||||
(pf, tf) <- typecheckSrc name src
|
||||
scope "parsed file" $ do
|
||||
pf <- maybe (crash (show ("Failed to parse" :: String, notes))) pure mayParsedFile
|
||||
let pfResult =
|
||||
UF.terms pf
|
||||
& firstJust \(_v, _fileAnn, trm) ->
|
||||
@ -260,7 +261,6 @@ makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $
|
||||
|
||||
when testTypechecked $
|
||||
scope "typechecked file" $ do
|
||||
tf <- maybe (crash "Failed to typecheck") pure mayTypecheckedFile
|
||||
let tfResult =
|
||||
UF.hashTermsId tf
|
||||
& toList
|
||||
@ -298,8 +298,7 @@ term x y = x && y
|
||||
|
||||
annotationNestingTest :: (String, Text) -> Test ()
|
||||
annotationNestingTest (name, src) = scope name do
|
||||
(_notes, _pf, maytf) <- typecheckSrc name src
|
||||
tf <- maybe (crash "Failed to typecheck") pure maytf
|
||||
(_, tf) <- typecheckSrc name src
|
||||
UF.hashTermsId tf
|
||||
& toList
|
||||
& traverse_ \(_fileAnn, _refId, _wk, trm, _typ) ->
|
||||
@ -323,20 +322,25 @@ assertAnnotationsAreNested term = do
|
||||
| isInFile -> pure ann
|
||||
| otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt)
|
||||
|
||||
typecheckSrc :: String -> Text -> Test (Seq (Result.Note Symbol Ann), Maybe (UF.UnisonFile Symbol Ann), Maybe (UF.TypecheckedUnisonFile Symbol Ann))
|
||||
typecheckSrc :: String -> Text -> Test (UF.UnisonFile Symbol Ann, UF.TypecheckedUnisonFile Symbol Ann)
|
||||
typecheckSrc name src = do
|
||||
withTestCodebase \codebase -> do
|
||||
let generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG
|
||||
let ambientAbilities = []
|
||||
let parseNames = mempty
|
||||
let lexedSource = (src, L.lexer name (Text.unpack src))
|
||||
r <- Typecheck.typecheck codebase generateUniqueName ambientAbilities parseNames (Text.pack name) lexedSource
|
||||
let Result.Result notes mayResult = r
|
||||
let (parsedFile, typecheckedFile) = case mayResult of
|
||||
Nothing -> (Nothing, Nothing)
|
||||
Just (Left uf) -> (Just uf, Nothing)
|
||||
Just (Right tf) -> (Just $ UF.discardTypes tf, Just tf)
|
||||
pure (notes, parsedFile, typecheckedFile)
|
||||
result <-
|
||||
withTestCodebase \codebase -> do
|
||||
uniqueName <- Parser.uniqueBase32Namegen <$> Random.getSystemDRG
|
||||
let ambientAbilities = []
|
||||
let parseNames = mempty
|
||||
let parsingEnv = Parser.ParsingEnv uniqueName parseNames
|
||||
case Parsers.parseFile name (Text.unpack src) parsingEnv of
|
||||
Left err -> pure (Left (crash ("Failed to parse: " ++ show err)))
|
||||
-- tf <- maybe (crash "Failed to typecheck") pure maytf
|
||||
Right unisonFile ->
|
||||
Codebase.runTransaction codebase (Typecheck.typecheckFileWithTNDR codebase ambientAbilities parsingEnv unisonFile) <&> \case
|
||||
Result.Result notes Nothing -> Left (crash ("Failed to typecheck: " ++ show (Foldable.toList @Seq notes)))
|
||||
Result.Result _ (Just typecheckedUnisonFile) -> Right (unisonFile, typecheckedUnisonFile)
|
||||
|
||||
case result of
|
||||
Left action -> action
|
||||
Right result -> pure result
|
||||
|
||||
withTestCodebase ::
|
||||
(Codebase IO Symbol Ann -> IO r) -> Test r
|
||||
|
Loading…
Reference in New Issue
Block a user