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

if/and/or-related type errors should be working now

Browse Source 
code looking a bit less ugly too.
This commit is contained in:
Arya Irani 2018-08-17 16:39:33 -04:00
parent b56b8b1dc3
commit 59f24188f6
2 changed files with 37 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
parser-typechecker/src/Unison/PrintError.hs
View File

@ -10,6 +10,7 @@
module Unison.PrintError where
-- import Unison.Parser (showLineCol)
import Control.Applicative ((<|>))
import qualified Data.Char as Char
import Data.Foldable
import qualified Data.List.NonEmpty as Nel
@ -501,28 +502,32 @@ typeErrorFromNote n@(C.Note (C.TypeMismatch ctx) path) =
(Just (foundLeaf, expectedLeaf),
Just (foundType, expectedType),
Just mismatchSite) ->
let mismatchLoc = ABT.annotation mismatchSite in
if Ex.matchAny Ex.inAndApp n then
BooleanMismatch AndMismatch (ABT.annotation mismatchSite) foundType n
-- else if Ex.matchAny Ex.inOrApp n then
-- BooleanMismatch OrMismatch (ABT.annotation mismatchSite) foundType n
-- else if Ex.matchAny Ex.inIfCond n then
-- BooleanMismatch CondMismatch (ABT.annotation mismatchSite) foundType n
else
case Ex.run Ex.inOrApp $ n of
Just _ ->
BooleanMismatch OrMismatch (ABT.annotation mismatchSite) foundType n
_ ->
case Ex.run Ex.inIfBody $ n of
Just expectedLoc ->
ExistentialMismatch IfBody expectedType expectedLoc
foundType mismatchLoc
n
Nothing ->
Mismatch (sub foundType) (sub expectedType)
(sub foundLeaf) (sub expectedLeaf)
(ABT.annotation mismatchSite)
n
let mismatchLoc = ABT.annotation mismatchSite
booleanMismatch :: Monad m => m a -> BooleanMismatch -> m (TypeError v loc)
booleanMismatch x y = x >>
(pure $ BooleanMismatch y (ABT.annotation mismatchSite) foundType n)
existentialMismatch :: Monad m
=> m loc -> ExistentialMismatch -> m (TypeError v loc)
existentialMismatch x y = x >>= \expectedLoc -> pure $
ExistentialMismatch y expectedType expectedLoc foundType mismatchLoc n
and,or,cond :: Ex.NoteExtractor v loc (TypeError v loc)
and = booleanMismatch Ex.inAndApp AndMismatch
or = booleanMismatch Ex.inOrApp OrMismatch
cond = booleanMismatch Ex.inIfCond CondMismatch
-- guard = tricky boolean mismatch
ifBody = existentialMismatch Ex.inIfBody IfBody
-- vectorBody = existentialMismatch Ex.inIfBody VectorBody
-- caseBody = existentialMismatch Ex.inIfBody CaseBody
all :: Ex.NoteExtractor v loc (TypeError v loc)
all = and <|> or <|> cond <|> ifBody
in case Ex.run all n of
Just err -> err
Nothing ->
Mismatch (sub foundType) (sub expectedType)
(sub foundLeaf) (sub expectedLeaf)
(ABT.annotation mismatchSite)
n
_ -> Other n
typeErrorFromNote n@(C.Note (C.AbilityCheckFailure amb req _) _) =
let go :: C.Term v loc -> TypeError v loc

22
parser-typechecker/src/Unison/Typechecker/Extractor.hs
View File

@ -33,18 +33,6 @@ adjacent (PathExtractor a) (PathExtractor b) =
type PathPredicate v loc = C.PathElement v loc -> Bool
inAndApp :: PathPredicate v loc
inAndApp C.InAndApp = True
inAndApp _ = False
inOrApp' :: PathPredicate v loc
inOrApp' C.InOrApp = True
inOrApp' _ = False
inIfCond :: PathPredicate v loc
inIfCond C.InIfCond = True
inIfCond _ = False
exactly1AppBefore :: PathExtractor v loc a -> NoteExtractor v loc a
exactly1AppBefore p = do
(prefix, a) <- elementsUntil p
@ -60,11 +48,21 @@ elementsUntil p = NoteExtractor $ go [] . toList . C.path where
Just a -> Just (reverse acc, a)
Nothing -> go (h:acc) t
inAndApp :: NoteExtractor v loc ()
inAndApp = exactly1AppBefore . PathExtractor $ \case
C.InAndApp -> Just ()
_ -> Nothing
inOrApp :: NoteExtractor v loc ()
inOrApp = exactly1AppBefore . PathExtractor $ \case
C.InOrApp -> Just ()
_ -> Nothing
inIfCond :: NoteExtractor v loc ()
inIfCond = exactly1AppBefore . PathExtractor $ \case
C.InIfCond -> Just ()
_ -> Nothing
inIfBody :: NoteExtractor v loc loc
inIfBody = exactly1AppBefore . PathExtractor $ \case
C.InIfBody loc -> Just loc