Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix compiler bug with rank 2 types in mapAccuml #2342

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
Draft

Fix compiler bug with rank 2 types in mapAccuml #2342

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2917a36
Fix compiler bug with rank 2 types in mapAccuml
CharlonTank Dec 14, 2024
0797247
Fix also rank 1 and 3
CharlonTank Dec 14, 2024
fe87fa4
feat: Implement value restriction and rank-N types - Add expansivenes…
CharlonTank Dec 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 47 additions & 46 deletions compiler/src/Type/Occurs.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,57 +24,58 @@ occurs var =

occursHelp :: [Type.Variable] -> Type.Variable -> Bool -> IO Bool
occursHelp seen var foundCycle =
if elem var seen then
if var `elem` seen then
return True

else
do (Descriptor content _ _ _) <- UF.get var
do (Descriptor content _ _ _ _) <- UF.get var
case content of
FlexVar _ ->
return foundCycle

FlexSuper _ _ ->
return foundCycle

RigidVar _ ->
return foundCycle

RigidSuper _ _ ->
return foundCycle

FlexVar _ -> return foundCycle
FlexSuper _ _ -> return foundCycle
RigidVar _ -> return foundCycle
RigidSuper _ _ -> return foundCycle
Structure term ->
let newSeen = var : seen in
case term of
App1 _ _ args ->
foldrM (occursHelp newSeen) foundCycle args

Fun1 a b ->
occursHelp newSeen a =<<
occursHelp newSeen b foundCycle

EmptyRecord1 ->
return foundCycle

Record1 fields ext ->
occursHelp newSeen ext =<<
foldrM (occursHelp newSeen) foundCycle (Map.elems fields)

Unit1 ->
return foundCycle

Tuple1 a b maybeC ->
case maybeC of
Nothing ->
occursHelp newSeen a =<<
occursHelp newSeen b foundCycle

Just c ->
occursHelp newSeen a =<<
occursHelp newSeen b =<<
occursHelp newSeen c foundCycle
case term of
App1 _ _ args ->
foldrM (occursHelp (var : seen)) foundCycle args

Fun1 arg result ->
do cycleInArg <- occursHelp (var : seen) arg foundCycle
if cycleInArg
then return True
else occursHelp (var : seen) result foundCycle

EmptyRecord1 ->
return foundCycle

Record1 fields extension ->
do cycleInFields <- foldrM (occursHelp (var : seen)) foundCycle (Map.elems fields)
if cycleInFields
then return True
else occursHelp (var : seen) extension foundCycle

Unit1 ->
return foundCycle

Tuple1 a b maybeC ->
case maybeC of
Nothing ->
do cycleInA <- occursHelp (var : seen) a foundCycle
if cycleInA
then return True
else occursHelp (var : seen) b foundCycle

Just c ->
do cycleInA <- occursHelp (var : seen) a foundCycle
if cycleInA
then return True
else do
cycleInB <- occursHelp (var : seen) b foundCycle
if cycleInB
then return True
else occursHelp (var : seen) c foundCycle

Alias _ _ args _ ->
foldrM (occursHelp (var:seen)) foundCycle (map snd args)
foldrM (occursHelp (var : seen)) foundCycle (map snd args)

Error ->
return foundCycle
return foundCycle
Loading