@@ -11,7 +11,7 @@ import Control.Monad.RWS
11import Control.Monad.State
11import Control.Monad.State
12import Data.List
12import Data.List
13import Data.Maybe
13import Data.Maybe
14−import qualified Data.Map as M
14+import qualified Data.Map.Strict as M
16import Debug.Trace
16import Debug.Trace
@@ -20,7 +20,8 @@ ucheck :: [(UConstraint, FC)] -> TC ()
20ucheck cs = acyclic rels (map fst (M.toList rels))
20ucheck cs = acyclic rels (map fst (M.toList rels))
21 where lhs (ULT l _) = l
21 where lhs (ULT l _) = l
22 lhs (ULE l _) = l
22 lhs (ULE l _) = l
23− rels = mkRels cs M.empty
24+ rels = mkRels cs' M.empty
25type Relations = M.Map UExp [(UConstraint, FC)]
26type Relations = M.Map UExp [(UConstraint, FC)]
@@ -44,13 +45,13 @@ acyclic r cvs = checkCycle (fileFC "root") r [] 0 cvs
44 checkCycle :: FC -> Relations -> [(UExp, FC)] -> Int -> [UExp] -> TC ()
45 checkCycle :: FC -> Relations -> [(UExp, FC)] -> Int -> [UExp] -> TC ()
45 checkCycle fc r path inc [] = return ()
46 checkCycle fc r path inc [] = return ()
46 checkCycle fc r path inc (c : cs)
47 checkCycle fc r path inc (c : cs)
47− = do check fc path inc c
48+ = do check fc r path inc c
48 -- Remove c from r since we know there's no cycles now
49 -- Remove c from r since we know there's no cycles now
49 let r' = M.insert c [] r
50 let r' = M.insert c [] r
50 checkCycle fc r' path inc cs
51 checkCycle fc r' path inc cs
52− check fc path inc (UVar x) | x < 0 = return ()
53+ check fc r path inc (UVar x) | x < 0 = return ()
53− check fc path inc cv
54+ check fc r path inc cv
54 | inc > 0 && cv `elem` map fst path
55 | inc > 0 && cv `elem` map fst path
55 = Error $ At fc UniverseError
56 = Error $ At fc UniverseError
56 -- FIXME: Make informative
57 -- FIXME: Make informative
@@ -59,10 +60,11 @@ acyclic r cvs = checkCycle (fileFC "root") r [] 0 cvs
59 -- fine, because they must all be equal, so stop.
60 -- fine, because they must all be equal, so stop.
60 | inc == 0 && cv `elem` map fst path
61 | inc == 0 && cv `elem` map fst path
61 = return ()
62 = return ()
62− | otherwise = case M.lookup cv r of
64+ = case M.lookup cv r of
63− Nothing -> return ()
65+ Nothing -> return ()
64− Just cs -> mapM_ (next ((cv, fc):path) inc) cs
66+ Just cs -> mapM_ (next r ((cv, fc):path) inc) cs
66− next path inc (ULT l r, fc) = check fc path (inc + 1) r
68+ next r path inc (ULT l x, fc) = check fc r path (inc + 1) x
67− next path inc (ULE l r, fc) = check fc path inc r
69+ next r path inc (ULE l x, fc) = check fc r path inc x