@@ -26,7 +26,7 @@ data CaseDef = CaseDef [Name] !SC [Term]
26-- in the function `prune` as a means of optimisation
26-- in the function `prune` as a means of optimisation
27-- of already built case trees.
27-- of already built case trees.
29−-- While the intermediate representation (follows in the pipeline)
29+-- While the intermediate representation (follows in the pipeline, named LExp)
30-- allows casing on arbitrary terms, here we choose to maintain the distinction
30-- allows casing on arbitrary terms, here we choose to maintain the distinction
31-- in order to allow for better optimisation opportunities.
31-- in order to allow for better optimisation opportunities.
@@ -546,25 +546,35 @@ caseGroups (v:vs) gs err = do g <- altGroups gs
546-- * clauses corresponding to (accVars ++ origVars ++ inaccVars)
546-- * clauses corresponding to (accVars ++ origVars ++ inaccVars)
547argsToAlt :: [Int] -> [([Pat], Clause)] -> CaseBuilder ([Name], [Name], [Name], [Clause])
547argsToAlt :: [Int] -> [([Pat], Clause)] -> CaseBuilder ([Name], [Name], [Name], [Clause])
548argsToAlt _ [] = return ([], [], [], [])
548argsToAlt _ [] = return ([], [], [], [])
549−argsToAlt inacc rs@((r, m) : rest)
549+argsToAlt inacc rs@((r, m) : rest) = do
550− = do newArgs <- getNewVars r
550+ newVars <- getNewVars r
551− return (newArgs, newArgs, [], addRs rs)
551+ return $ case inacc of
552+ [] -> (newVars, newVars, [], addRs rs) -- no inaccessible arguments
553+ _ -> error "inaccessible data ctor args not implemented"
555+ -- Create names for new variables arising from the given patterns.
556+ getNewVars :: [Pat] -> CaseBuilder [Name]
553 getNewVars [] = return []
557 getNewVars [] = return []
554 getNewVars ((PV n t) : ns) = do v <- getVar "e"
558 getNewVars ((PV n t) : ns) = do v <- getVar "e"
559+ nsv <- getNewVars ns
561+ -- Record the type of the variable.
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).
567+ -- The code that reads this is currently
568+ -- commented out, anyway.
555 (cs, i, ntys) <- get
569 (cs, i, ntys) <- get
556 put (cs, i, (v, t) : ntys)
570 put (cs, i, (v, t) : ntys)
557− nsv <- getNewVars ns
571+
558 return (v : nsv)
572 return (v : nsv)
559− getNewVars (PAny : ns) = do v <- getVar "i"
574+ getNewVars (PAny : ns) = (:) <$> getVar "i" <*> getNewVars ns
560− nsv <- getNewVars ns
562− getNewVars (PTyPat : ns) = do v <- getVar "t"
575+ getNewVars (PTyPat : ns) = (:) <$> getVar "t" <*> getNewVars ns
563− nsv <- getNewVars ns
565− getNewVars (_ : ns) = do v <- getVar "e"
576+ getNewVars (_ : ns) = (:) <$> getVar "e" <*> getNewVars ns
566− nsv <- getNewVars ns
577+
568 addRs [] = []
578 addRs [] = []
569 addRs ((r, (ps, res)) : rs) = ((r++ps, res) : addRs rs)
579 addRs ((r, (ps, res)) : rs) = ((r++ps, res) : addRs rs)