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

52
src/Bergamot/Syntax.elm
View File

@ -109,12 +109,21 @@ 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) ->
unify t1 t2 us if occurs ui1.equivalence us t2 || occurs ui2.equivalence us t1
|> Maybe.map (\(t, usp) -> reconcile newEq (Just t) usp) then Nothing
else
unify t1 t2 us
|> Maybe.map (\(t, usp) -> reconcile newEq (Just t) usp)
(Just t1, Nothing) -> (Just t1, Nothing) ->
Just (reconcile newEq (Just t1) us) if occurs ui2.equivalence us t1
then Nothing
else
Just (reconcile newEq (Just t1) us)
(Nothing, Just t2) -> (Nothing, Just t2) ->
Just (reconcile newEq (Just t2) us) if occurs ui1.equivalence us t2
then Nothing
else
Just (reconcile newEq (Just t2) us)
(Nothing, Nothing) -> (Nothing, Nothing) ->
Just (reconcile newEq Nothing us) Just (reconcile newEq Nothing us)
(Just ui1, Nothing) -> Just (reconcile (Set.insert v2s ui1.equivalence) ui1.term us) (Just ui1, Nothing) -> Just (reconcile (Set.insert v2s ui1.equivalence) ui1.term 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 ->
case ui.term of if occurs ui.equivalence us t
Just tp -> then Nothing
unify t tp us else
|> Maybe.map (\(tpp, usp) -> (tpp, reconcile ui.equivalence (Just tpp) usp)) case ui.term of
Nothing -> Just tp ->
Just (t, reconcile ui.equivalence (Just t) us) unify t tp us
Nothing -> Just (t, Dict.insert vs { equivalence = Set.singleton vs, term = Just t } us) |> Maybe.map (\(tpp, usp) -> (tpp, reconcile ui.equivalence (Just tpp) usp))
Nothing ->
Just (t, reconcile ui.equivalence (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 =