From ff892bb7c7808ff9cccf1d2ba2e840ff505d8e57 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 9 Nov 2018 16:52:45 -0500 Subject: [PATCH] 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" --- parser-typechecker/bootstrap/Bootstrap.hs | 3 +- parser-typechecker/src/Unison/Codebase.hs | 56 ++++++++++++-------- parser-typechecker/src/Unison/FileParsers.hs | 3 +- parser-typechecker/src/Unison/UnisonFile.hs | 8 +-- 4 files changed, 42 insertions(+), 28 deletions(-) diff --git a/parser-typechecker/bootstrap/Bootstrap.hs b/parser-typechecker/bootstrap/Bootstrap.hs index 2f6422dde..6e4f9dfd6 100644 --- a/parser-typechecker/bootstrap/Bootstrap.hs +++ b/parser-typechecker/bootstrap/Bootstrap.hs @@ -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 diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index e4045f84e..929af34b5 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -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 diff --git a/parser-typechecker/src/Unison/FileParsers.hs b/parser-typechecker/src/Unison/FileParsers.hs index 8faec6950..dc01bafb8 100644 --- a/parser-typechecker/src/Unison/FileParsers.hs +++ b/parser-typechecker/src/Unison/FileParsers.hs @@ -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 diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 92552542b..1095b60dd 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -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