on master help sign in
More changes to argsToAlt.
commit1e3734863cd4dfb3c17ef6e257c8a0e523c9b8d1 authorMatus Tejiscak <ziman@functor.sk> dateSat 5 Jul 2014, 20:47 (12 years ago) parent2cc6526
1 file changed+24−14
src/Idris/Core/CaseTree.hs+24−14
src/Idris/Core/CaseTree.hs+24−14
@@ -26,7 +26,7 @@ data CaseDef = CaseDef [Name] !SC [Term]
2626-- in the function `prune` as a means of optimisation
2727-- of already built case trees.
2828--
29−-- While the intermediate representation (follows in the pipeline)
29+-- While the intermediate representation (follows in the pipeline, named LExp)
3030-- allows casing on arbitrary terms, here we choose to maintain the distinction
3131-- in order to allow for better optimisation opportunities.
3232--
@@ -546,25 +546,35 @@ caseGroups (v:vs) gs err = do g <- altGroups gs
546546-- * clauses corresponding to (accVars ++ origVars ++ inaccVars)
547547argsToAlt :: [Int] -> [([Pat], Clause)] -> CaseBuilder ([Name], [Name], [Name], [Clause])
548548argsToAlt _ [] = return ([], [], [], [])
549−argsToAlt inacc rs@((r, m) : rest)
550− = do newArgs <- getNewVars r
551− return (newArgs, newArgs, [], addRs rs)
549+argsToAlt inacc rs@((r, m) : rest) = do
550+ newVars <- getNewVars r
551+ return $ case inacc of
552+ [] -> (newVars, newVars, [], addRs rs) -- no inaccessible arguments
553+ _ -> error "inaccessible data ctor args not implemented"
552554 where
555+ -- Create names for new variables arising from the given patterns.
556+ getNewVars :: [Pat] -> CaseBuilder [Name]
553557 getNewVars [] = return []
554558 getNewVars ((PV n t) : ns) = do v <- getVar "e"
559+ nsv <- getNewVars ns
560+
561+ -- Record the type of the variable.
562+ --
563+ -- It seems that the ordering is not important
564+ -- and we can put (v,t) always in front of "ntys"
565+ -- (the varName-type pairs seem to represent a mapping).
566+ --
567+ -- The code that reads this is currently
568+ -- commented out, anyway.
555569 (cs, i, ntys) <- get
556570 put (cs, i, (v, t) : ntys)
557− nsv <- getNewVars ns
571+
558572 return (v : nsv)
559− getNewVars (PAny : ns) = do v <- getVar "i"
560− nsv <- getNewVars ns
561− return (v : nsv)
562− getNewVars (PTyPat : ns) = do v <- getVar "t"
563− nsv <- getNewVars ns
564− return (v : nsv)
565− getNewVars (_ : ns) = do v <- getVar "e"
566− nsv <- getNewVars ns
567− return (v : nsv)
573+
574+ getNewVars (PAny : ns) = (:) <$> getVar "i" <*> getNewVars ns
575+ getNewVars (PTyPat : ns) = (:) <$> getVar "t" <*> getNewVars ns
576+ getNewVars (_ : ns) = (:) <$> getVar "e" <*> getNewVars ns
577+
568578 addRs [] = []
569579 addRs ((r, (ps, res)) : rs) = ((r++ps, res) : addRs rs)
570580