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

further simplified ability check

Browse Source
This commit is contained in:
Paul Chiusano 2018-08-13 22:27:04 -04:00
parent 55b5c608ce
commit bdd6097286
1 changed files with 8 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
parser-typechecker/src/Unison/Typechecker/Context.hs
View File

@ -1079,25 +1079,14 @@ solve ctx v t
abilityCheck' :: (Var v, Ord loc) => [Type v loc] -> [Type v loc] -> M v loc ()
abilityCheck' [] [] = pure ()
abilityCheck' ambient requested = do
let !_ = traceShow ("ambient" :: String, ambient, "requested" :: String, requested) ()
-- if requested is an existential that is unsolved, go ahead and unify that
-- with all of ambient
ctx <- getContext
let es = [ Type.existential' (loc t) b v
| t@(Type.Existential' b v) <- apply ctx <$> requested ]
case es of
h : _t -> subtype h (Type.effects (loc h) ambient)
[] -> do
success <- flip allM requested $ \req -> do
-- NB - if there's an exact match, use that
let toCheck = maybe ambient pure $ find (== req) ambient
ok <- flip anyM toCheck $ \amb -> (True <$ subtype amb req) `orElse` pure False
pure ok
when (not success) $ do
ctx <- getContext
failWith $ AbilityCheckFailure (apply ctx <$> ambient)
(apply ctx <$> requested)
ctx
-- let !_ = traceShow ("ambient" :: String, ambient, "requested" :: String, requested) ()
success <- flip allM requested $ \req -> do
flip anyM ambient $ \amb -> (True <$ subtype amb req) `orElse` pure False
when (not success) $ do
ctx <- getContext
failWith $ AbilityCheckFailure (apply ctx <$> ambient)
(apply ctx <$> requested)
ctx
abilityCheck :: (Var v, Ord loc) => [Type v loc] -> M v loc ()
abilityCheck requested = do