@@ -213,6 +213,7 @@ isUsed sc n = used sc where
213 usedA (SucCase _ sc) = used sc
213 usedA (SucCase _ sc) = used sc
214 usedA (DefaultCase sc) = used sc
214 usedA (DefaultCase sc) = used sc
216+type CaseBuilder a = State CS a
217data Phase = CompileTime | RunTime
218data Phase = CompileTime | RunTime
218 deriving (Show, Eq)
219 deriving (Show, Eq)
@@ -459,7 +460,7 @@ order ns' cs = let patnames = transpose (map (zip ns') (map fst cs))
459 numNames xs [] = length xs
460 numNames xs [] = length xs
461match :: [Name] -> [Clause] -> SC -- error case
462match :: [Name] -> [Clause] -> SC -- error case
462− -> State CS SC
463+ -> CaseBuilder SC
463match [] (([], ret) : xs) err
464match [] (([], ret) : xs) err
464 = do (ts, v, ntys) <- get
465 = do (ts, v, ntys) <- get
465 put (ts ++ (map (fst.snd) xs), v, ntys)
466 put (ts ++ (map (fst.snd) xs), v, ntys)
@@ -469,7 +470,7 @@ match [] (([], ret) : xs) err
469match vs cs err = do let ps = partition cs
470match vs cs err = do let ps = partition cs
470 mixture vs ps err
471 mixture vs ps err
472−mixture :: [Name] -> [Partition] -> SC -> State CS SC
473+mixture :: [Name] -> [Partition] -> SC -> CaseBuilder SC
473mixture vs [] err = return err
474mixture vs [] err = return err
474mixture vs (Cons ms : ps) err = do fallthrough <- mixture vs ps err
475mixture vs (Cons ms : ps) err = do fallthrough <- mixture vs ps err
475 conRule vs ms fallthrough
476 conRule vs ms fallthrough
@@ -486,11 +487,11 @@ data Group = ConGroup ConType -- Constructor
486 [([Pat], Clause)] -- arguments and rest of alternative
487 [([Pat], Clause)] -- arguments and rest of alternative
487 deriving Show
488 deriving Show
489−conRule :: [Name] -> [Clause] -> SC -> State CS SC
490+conRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
490conRule (v:vs) cs err = do groups <- groupCons cs
491conRule (v:vs) cs err = do groups <- groupCons cs
491 caseGroups (v:vs) groups err
492 caseGroups (v:vs) groups err
493−caseGroups :: [Name] -> [Group] -> SC -> State CS SC
494+caseGroups :: [Name] -> [Group] -> SC -> CaseBuilder SC
494caseGroups (v:vs) gs err = do g <- altGroups gs
495caseGroups (v:vs) gs err = do g <- altGroups gs
495 return $ Case v (sort g)
496 return $ Case v (sort g)
@@ -525,7 +526,7 @@ caseGroups (v:vs) gs err = do g <- altGroups gs
525 matchCs <- match vs nextCs err
526 matchCs <- match vs nextCs err
526 return $ ConstCase n matchCs
527 return $ ConstCase n matchCs
528−argsToAlt :: [([Pat], Clause)] -> State CS ([Name], [Clause])
529+argsToAlt :: [([Pat], Clause)] -> CaseBuilder ([Name], [Clause])
529argsToAlt [] = return ([], [])
530argsToAlt [] = return ([], [])
530argsToAlt rs@((r, m) : rest)
531argsToAlt rs@((r, m) : rest)
531 = do newArgs <- getNewVars r
532 = do newArgs <- getNewVars r
@@ -552,10 +553,10 @@ argsToAlt rs@((r, m) : rest)
552 uniq i (UN n) = MN i n
553 uniq i (UN n) = MN i n
553 uniq i n = n
554 uniq i n = n
555−getVar :: String -> State CS Name
556+getVar :: String -> CaseBuilder Name
556getVar b = do (t, v, ntys) <- get; put (t, v+1, ntys); return (sMN v b)
557getVar b = do (t, v, ntys) <- get; put (t, v+1, ntys); return (sMN v b)
558−groupCons :: [Clause] -> State CS [Group]
559+groupCons :: [Clause] -> CaseBuilder [Group]
559groupCons cs = gc [] cs
560groupCons cs = gc [] cs
561 gc acc [] = return acc
562 gc acc [] = return acc
@@ -581,7 +582,7 @@ groupCons cs = gc [] cs
581-- | otherwise = g : addConG con res gs
582-- | otherwise = g : addConG con res gs
582 addConG con res (g : gs) = g : addConG con res gs
583 addConG con res (g : gs) = g : addConG con res gs
584−varRule :: [Name] -> [Clause] -> SC -> State CS SC
585+varRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
585varRule (v : vs) alts err =
586varRule (v : vs) alts err =
586 do alts' <- mapM (repVar v) alts
587 do alts' <- mapM (repVar v) alts
587 match vs alts' err
588 match vs alts' err