git.iko.soy/elk
on 2deedfb help sign in
elk/src/Type/Occurs.hs
80 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Type.Occurs
4 ( occurs
5 )
6 where
9import Data.Foldable (foldrM)
10import qualified Data.Map.Strict as Map
12import Type.Type as Type
13import qualified Type.UnionFind as UF
17-- OCCURS
20occurs :: Type.Variable -> IO Bool
21occurs var =
22 occursHelp [] var False
25occursHelp :: [Type.Variable] -> Type.Variable -> Bool -> IO Bool
26occursHelp seen var foundCycle =
27 if elem var seen then
28 return True
30 else
31 do (Descriptor content _ _ _) <- UF.get var
32 case content of
33 FlexVar _ ->
34 return foundCycle
36 FlexSuper _ _ ->
37 return foundCycle
39 RigidVar _ ->
40 return foundCycle
42 RigidSuper _ _ ->
43 return foundCycle
45 Structure term ->
46 let newSeen = var : seen in
47 case term of
48 App1 _ _ args ->
49 foldrM (occursHelp newSeen) foundCycle args
51 Fun1 a b ->
52 occursHelp newSeen a =<<
53 occursHelp newSeen b foundCycle
55 EmptyRecord1 ->
56 return foundCycle
58 Record1 fields ext ->
59 occursHelp newSeen ext =<<
60 foldrM (occursHelp newSeen) foundCycle (Map.elems fields)
62 Unit1 ->
63 return foundCycle
65 Tuple1 a b maybeC ->
66 case maybeC of
67 Nothing ->
68 occursHelp newSeen a =<<
69 occursHelp newSeen b foundCycle
71 Just c ->
72 occursHelp newSeen a =<<
73 occursHelp newSeen b =<<
74 occursHelp newSeen c foundCycle
76 Alias _ _ args _ ->
77 foldrM (occursHelp (var:seen)) foundCycle (map snd args)
79 Error _ ->
80 return foundCycle