Everything-I-Know-About-Types/bergamot-elm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add an occurss check to avoid infinite terms

Browse Source 
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2023-12-22 14:39:35 -08:00
parent abd6a848f8
commit da470f5caa
1 changed files with 41 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Bergamot/Syntax.elm
View File

@ -109,11 +109,20 @@ merge v1 v2 us =
in in
case (ui1.term, ui2.term) of case (ui1.term, ui2.term) of
(Just t1, Just t2) -> (Just t1, Just t2) ->
if occurs ui1.equivalence us t2 || occurs ui2.equivalence us t1
then Nothing
else
unify t1 t2 us unify t1 t2 us
|> Maybe.map (\(t, usp) -> reconcile newEq (Just t) usp) |> Maybe.map (\(t, usp) -> reconcile newEq (Just t) usp)
(Just t1, Nothing) -> (Just t1, Nothing) ->
if occurs ui2.equivalence us t1
then Nothing
else
Just (reconcile newEq (Just t1) us) Just (reconcile newEq (Just t1) us)
(Nothing, Just t2) -> (Nothing, Just t2) ->
if occurs ui1.equivalence us t2
then Nothing
else
Just (reconcile newEq (Just t2) us) Just (reconcile newEq (Just t2) us)
(Nothing, Nothing) -> (Nothing, Nothing) ->
Just (reconcile newEq Nothing us) Just (reconcile newEq Nothing us)
@ -128,13 +137,34 @@ set v t us =
in in
case Dict.get vs us of case Dict.get vs us of
Just ui -> Just ui ->
if occurs ui.equivalence us t
then Nothing
else
case ui.term of case ui.term of
Just tp -> Just tp ->
unify t tp us unify t tp us
|> Maybe.map (\(tpp, usp) -> (tpp, reconcile ui.equivalence (Just tpp) usp)) |> Maybe.map (\(tpp, usp) -> (tpp, reconcile ui.equivalence (Just tpp) usp))
Nothing -> Nothing ->
Just (t, reconcile ui.equivalence (Just t) us) Just (t, reconcile ui.equivalence (Just t) us)
Nothing -> Just (t, Dict.insert vs { equivalence = Set.singleton vs, term = Just t } us) Nothing ->
if occurs (Set.singleton vs) us t
then Nothing
else
Just (t, Dict.insert vs { equivalence = Set.singleton vs, term = Just t } us)
occurs : Set String -> UnificationState -> Term UnificationVar -> Bool
occurs vars us t =
case t of
IntLit _ -> False
StringLit _ -> False
Call n ts -> List.any (occurs vars us) ts
Var (MkUnificationVar v) -> if Set.member v vars then True else
case Dict.get v us of
Just { term } ->
case term of
Just tp -> occurs vars us tp
Nothing -> False
_ -> False
unifyList : List (Term UnificationVar) -> List (Term UnificationVar) -> UnificationState -> Maybe (List (Term UnificationVar), UnificationState) unifyList : List (Term UnificationVar) -> List (Term UnificationVar) -> UnificationState -> Maybe (List (Term UnificationVar), UnificationState)
unifyList l1 l2 us = unifyList l1 l2 us =