mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Work-around for Effect annotations bug. (#3789)
* Failing effect list annotation tests * Workaround for incorrect effect issues
This commit is contained in:
parent
757eb7355f
commit
4f817610d6
@ -174,7 +174,11 @@ findSmallestEnclosingType pos typ
|
||||
ABT.Tm f -> case f of
|
||||
Type.Ref {} -> Just typ
|
||||
Type.Arrow a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
|
||||
Type.Effect a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
|
||||
Type.Effect effs rhs ->
|
||||
-- There's currently a bug in the annotations for effects which cause them to
|
||||
-- span larger than they should. As a workaround for now we just make sure to
|
||||
-- search the RHS before the effects.
|
||||
findSmallestEnclosingType pos rhs <|> findSmallestEnclosingType pos effs
|
||||
Type.App a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
|
||||
Type.Forall r -> findSmallestEnclosingType pos r
|
||||
Type.Ann a _kind -> findSmallestEnclosingType pos a
|
||||
|
@ -110,6 +110,45 @@ term = let
|
||||
True,
|
||||
Left (Term.Boolean True)
|
||||
),
|
||||
( "Test annotations for types with arrows",
|
||||
[here|
|
||||
structural type Thing = This | That
|
||||
|
||||
term : Thing -> Thing -> Thi^ng
|
||||
term a b = This
|
||||
|],
|
||||
True,
|
||||
Right (Type.Ref (Reference.unsafeFromText "#6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0"))
|
||||
),
|
||||
( "Test annotations for types with effects",
|
||||
[here|
|
||||
unique ability Foo a where
|
||||
foo : a
|
||||
|
||||
unique ability Bar b where
|
||||
bar : b
|
||||
|
||||
structural type Thing = This | That
|
||||
|
||||
term : (Thing -> {Foo a, Bar b} Th^ing) -> {Foo a, Bar b} Thing
|
||||
term f = f This
|
||||
|],
|
||||
True,
|
||||
Right (Type.Ref (Reference.unsafeFromText "#6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0"))
|
||||
),
|
||||
( "Test annotations for effects themselves",
|
||||
[here|
|
||||
structural ability Foo a where
|
||||
foo : a
|
||||
|
||||
structural type Thing = This | That
|
||||
|
||||
term : () -> {F^oo a} Thing
|
||||
term _ = This
|
||||
|],
|
||||
True,
|
||||
Right (Type.Ref (Reference.unsafeFromText "#h4uhcub76va4tckj1iccnsb07rh0fhgpigqapb4jh5n07s0tugec4nm2vikuv973mab7oh4ne07o6armcnnl7mbfjtb4imphgrjgimg"))
|
||||
),
|
||||
-- ( "Test annotations for blocks with destructuring binds",
|
||||
-- [here|
|
||||
-- term = let
|
||||
|
@ -279,7 +279,7 @@ mvarRef = Reference.Builtin "MVar"
|
||||
tvarRef = Reference.Builtin "TVar"
|
||||
|
||||
ticketRef :: Reference
|
||||
ticketRef = Reference.Builtin "Ref.Ticket"
|
||||
ticketRef = Reference.Builtin "Ref.Ticket"
|
||||
|
||||
promiseRef :: Reference
|
||||
promiseRef = Reference.Builtin "Promise"
|
||||
|
Loading…
Reference in New Issue
Block a user