mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-04 21:57:25 +03:00
haskell tests 430 passing, 18 failed...
"typechecker.tests/ask-inferred.u" "typechecker.tests/console.u" "typechecker.tests/language-reference.u" "typechecker.tests/map-reduce.u" "typechecker.tests/pattern-matching.u" "typechecker.tests/sequence-at-0.u" "typechecker.tests/state2a-min.u" "typechecker.tests/state2a.u" "typechecker.tests/state2b-min.u" "typechecker.tests/state2b.u" "typechecker.tests/state4.u" "typechecker.tests/tdnr.u" "typechecker.tests/tdnr2.u" "typechecker.tests/tdnr3.u" "typechecker.tests/tdnr4.u" "typechecker.tests/tictactoe.u" "typechecker.tests/tictactoe0.u" "typechecker.tests/tictactoe2.u"
This commit is contained in:
parent
c5c8cec987
commit
ff892bb7c7
@ -36,7 +36,8 @@ main = do
|
||||
source <- unpack <$> Data.Text.IO.readFile sourceFile
|
||||
(env0, unisonFile) <- Parsers.unsafeReadAndParseFile B.names sourceFile
|
||||
let (Result notes' r) =
|
||||
FileParsers.synthesizeAndSerializeUnisonFile B.names unisonFile
|
||||
FileParsers.synthesizeAndSerializeUnisonFile
|
||||
B.typeLookup B.names unisonFile
|
||||
f (unisonFile', bs) = do
|
||||
putStrLn $ "typechecked as " ++ renderType' env0 (UF.typ unisonFile')
|
||||
traverse_ (flip BS.writeFile bs) outputFile
|
||||
|
@ -1,42 +1,42 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Unison.Codebase where
|
||||
|
||||
import Data.String ( fromString )
|
||||
import Control.Monad ( forM )
|
||||
import Data.Foldable ( toList, traverse_ )
|
||||
import Data.Maybe ( catMaybes )
|
||||
import Control.Monad (forM, foldM)
|
||||
import Data.Foldable (toList, traverse_)
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
import Data.Set ( Set )
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Set (Set)
|
||||
import Data.String (fromString)
|
||||
import qualified Data.Text as Text
|
||||
import Text.EditDistance ( defaultEditCosts
|
||||
, levenshteinDistance
|
||||
)
|
||||
import Text.EditDistance (defaultEditCosts,
|
||||
levenshteinDistance)
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Builtin as Builtin
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import Unison.Parser ( Ann )
|
||||
import Unison.Names (Name)
|
||||
import Unison.Parser (Ann)
|
||||
import qualified Unison.PrettyPrintEnv as PPE
|
||||
import Unison.Reference ( Reference )
|
||||
import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Term as Term
|
||||
import qualified Unison.TermPrinter as TermPrinter
|
||||
import qualified Unison.Type as Type
|
||||
import Unison.Typechecker.TypeLookup (Decl, TypeLookup (TypeLookup))
|
||||
import qualified Unison.Typechecker.TypeLookup as TL
|
||||
import Unison.Typechecker.TypeLookup (Decl,TypeLookup)
|
||||
import Unison.Util.PrettyPrint ( PrettyPrint )
|
||||
import Unison.Util.AnnotatedText (AnnotatedText)
|
||||
import Unison.Util.ColorText (Color)
|
||||
import Unison.Util.PrettyPrint (PrettyPrint)
|
||||
import qualified Unison.Util.PrettyPrint as PP
|
||||
import Unison.Util.AnnotatedText ( AnnotatedText )
|
||||
import Unison.Util.ColorText ( Color )
|
||||
import qualified Unison.Var as Var
|
||||
import qualified Unison.ABT as ABT
|
||||
import Unison.Names (Name)
|
||||
|
||||
type DataDeclaration v a = DD.DataDeclaration' v a
|
||||
type EffectDeclaration v a = DD.EffectDeclaration' v a
|
||||
@ -70,7 +70,7 @@ typecheckingEnvironment code t = do
|
||||
let allDecls = Map.fromList [ (r, d) | (r, Just d) <- decls0 ]
|
||||
(datas, effects) = foldl' go (mempty, mempty) (Map.toList allDecls)
|
||||
go (datas, effects) (r, d) = case d of
|
||||
Left e -> (datas, Map.insert r e effects)
|
||||
Left e -> (datas, Map.insert r e effects)
|
||||
Right d -> (Map.insert r d datas, effects)
|
||||
pure $ TL.TypeLookup termTypes datas effects
|
||||
|
||||
@ -142,8 +142,20 @@ prettyListingQ :: (Var.Var v, Monad m)
|
||||
prettyListingQ _cb _query _b =
|
||||
error "todo - find all matches, display similar output to PrintError.prettyTypecheckedFile"
|
||||
|
||||
typeLookupForDependencies :: Codebase m v a -> Set Reference -> m (TL.TypeLookup v a)
|
||||
typeLookupForDependencies code refs = error "todo"
|
||||
typeLookupForDependencies :: Monad m =>
|
||||
Codebase m v a -> Set Reference -> m (TL.TypeLookup v a)
|
||||
typeLookupForDependencies codebase refs = foldM go mempty refs
|
||||
where go tl ref@(Reference.DerivedId id) = fmap (tl <>) $ do
|
||||
getTypeOfTerm codebase ref >>= \case
|
||||
Just typ -> pure $ TypeLookup (Map.singleton ref typ) mempty mempty
|
||||
Nothing -> getTypeDeclaration codebase id >>= \case
|
||||
Just (Left ed) ->
|
||||
pure $ TypeLookup mempty mempty (Map.singleton ref ed)
|
||||
Just (Right dd) ->
|
||||
pure $ TypeLookup mempty (Map.singleton ref dd) mempty
|
||||
Nothing -> pure mempty
|
||||
go tl _builtin = pure tl -- codebase isn't consulted for builtins
|
||||
|
||||
|
||||
sortedApproximateMatches :: String -> [String] -> [String]
|
||||
sortedApproximateMatches q possible = sortOn score matches where
|
||||
|
@ -32,7 +32,6 @@ import Unison.Parser (Ann (Intrinsic))
|
||||
import qualified Unison.Parsers as Parsers
|
||||
import qualified Unison.PrettyPrintEnv as PPE
|
||||
import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import Unison.Result (Note (..), Result, pattern Result, ResultT)
|
||||
import qualified Unison.Result as Result
|
||||
import Unison.Term (AnnotatedTerm)
|
||||
@ -109,7 +108,7 @@ synthesizeFile lookupType preexistingNames unisonFile = do
|
||||
-- substitute builtins into the datas/effects/body of unisonFile
|
||||
uf@(UnisonFile dds0 eds0 term0) = unisonFile
|
||||
localNames = UF.toNames uf
|
||||
localTypes = UF.toTypeLookup uf
|
||||
localTypes = UF.declsToTypeLookup uf
|
||||
-- this is the preexisting terms and decls plus the local decls
|
||||
allTheNames = localNames <> preexistingNames
|
||||
term = Names.bindTerm allTheNames term0
|
||||
|
@ -20,7 +20,6 @@ import qualified Unison.DataDeclaration as DD
|
||||
import Unison.Names (Names)
|
||||
import qualified Unison.Names as Names
|
||||
import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import Unison.Term (AnnotatedTerm)
|
||||
import qualified Unison.Term as Term
|
||||
import Unison.Type (AnnotatedType)
|
||||
@ -84,8 +83,11 @@ discardTerm :: TypecheckedUnisonFile' v a -> TypecheckedUnisonFile v a
|
||||
discardTerm (TypecheckedUnisonFile' datas effects tlcs _ _) =
|
||||
TypecheckedUnisonFile datas effects tlcs
|
||||
|
||||
toTypeLookup :: Var v => UnisonFile v a -> TL.TypeLookup v a
|
||||
toTypeLookup uf = error "todo"
|
||||
declsToTypeLookup :: Var v => UnisonFile v a -> TL.TypeLookup v a
|
||||
declsToTypeLookup uf = TL.TypeLookup mempty
|
||||
(wrangle (dataDeclarations uf))
|
||||
(wrangle (effectDeclarations uf))
|
||||
where wrangle = Map.fromList . Map.elems
|
||||
|
||||
toNames :: Var v => UnisonFile v a -> Names
|
||||
toNames (UnisonFile {..}) = datas <> effects
|
||||
|
Loading…
Reference in New Issue
Block a user