on master help sign in
Create the CaseBuilder monad alias.
commitb0cb4e2aaa597b6928992a6ca441442db7f8a93b authorMatus Tejiscak <ziman@functor.sk> dateFri 4 Jul 2014, 14:03 (12 years ago) parentf2e30f2
1 file changed+9−8
src/Idris/Core/CaseTree.hs+9−8
src/Idris/Core/CaseTree.hs+9−8
@@ -213,6 +213,7 @@ isUsed sc n = used sc where
213213 usedA (SucCase _ sc) = used sc
214214 usedA (DefaultCase sc) = used sc
215215
216+type CaseBuilder a = State CS a
216217
217218data Phase = CompileTime | RunTime
218219 deriving (Show, Eq)
@@ -459,7 +460,7 @@ order ns' cs = let patnames = transpose (map (zip ns') (map fst cs))
459460 numNames xs [] = length xs
460461
461462match :: [Name] -> [Clause] -> SC -- error case
462− -> State CS SC
463+ -> CaseBuilder SC
463464match [] (([], ret) : xs) err
464465 = do (ts, v, ntys) <- get
465466 put (ts ++ (map (fst.snd) xs), v, ntys)
@@ -469,7 +470,7 @@ match [] (([], ret) : xs) err
469470match vs cs err = do let ps = partition cs
470471 mixture vs ps err
471472
472−mixture :: [Name] -> [Partition] -> SC -> State CS SC
473+mixture :: [Name] -> [Partition] -> SC -> CaseBuilder SC
473474mixture vs [] err = return err
474475mixture vs (Cons ms : ps) err = do fallthrough <- mixture vs ps err
475476 conRule vs ms fallthrough
@@ -486,11 +487,11 @@ data Group = ConGroup ConType -- Constructor
486487 [([Pat], Clause)] -- arguments and rest of alternative
487488 deriving Show
488489
489−conRule :: [Name] -> [Clause] -> SC -> State CS SC
490+conRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
490491conRule (v:vs) cs err = do groups <- groupCons cs
491492 caseGroups (v:vs) groups err
492493
493−caseGroups :: [Name] -> [Group] -> SC -> State CS SC
494+caseGroups :: [Name] -> [Group] -> SC -> CaseBuilder SC
494495caseGroups (v:vs) gs err = do g <- altGroups gs
495496 return $ Case v (sort g)
496497 where
@@ -525,7 +526,7 @@ caseGroups (v:vs) gs err = do g <- altGroups gs
525526 matchCs <- match vs nextCs err
526527 return $ ConstCase n matchCs
527528
528−argsToAlt :: [([Pat], Clause)] -> State CS ([Name], [Clause])
529+argsToAlt :: [([Pat], Clause)] -> CaseBuilder ([Name], [Clause])
529530argsToAlt [] = return ([], [])
530531argsToAlt rs@((r, m) : rest)
531532 = do newArgs <- getNewVars r
@@ -552,10 +553,10 @@ argsToAlt rs@((r, m) : rest)
552553 uniq i (UN n) = MN i n
553554 uniq i n = n
554555
555−getVar :: String -> State CS Name
556+getVar :: String -> CaseBuilder Name
556557getVar b = do (t, v, ntys) <- get; put (t, v+1, ntys); return (sMN v b)
557558
558−groupCons :: [Clause] -> State CS [Group]
559+groupCons :: [Clause] -> CaseBuilder [Group]
559560groupCons cs = gc [] cs
560561 where
561562 gc acc [] = return acc
@@ -581,7 +582,7 @@ groupCons cs = gc [] cs
581582-- | otherwise = g : addConG con res gs
582583 addConG con res (g : gs) = g : addConG con res gs
583584
584−varRule :: [Name] -> [Clause] -> SC -> State CS SC
585+varRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
585586varRule (v : vs) alts err =
586587 do alts' <- mapM (repVar v) alts
587588 match vs alts' err