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:
Arya Irani 2018-11-09 16:52:45 -05:00
parent c5c8cec987
commit ff892bb7c7
4 changed files with 42 additions and 28 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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