60a441b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Fix bug in compilation of optimised Nats

60a441bEdwin Brady13 years ago

src/Core/CaseTree.hs+4

compare with master

unifiedsplit

@@ -501,6 +501,10 @@ prune proj (Case n alts)

501 [] -> ImpossibleCase

502 as@[ConCase cn i args sc] -> if proj then mkProj n 0 args sc

503 else Case n as

504+ -- Bit of a hack here! The default case will always be 0, make sure

505+ -- it gets caught first.

506+ [s@(SucCase _ _), DefaultCase dc]

507+ -> Case n [ConstCase (BI 0) dc, s]

504 as -> Case n as

508 as -> Case n as

505 where pruneAlt (ConCase cn i ns sc) = ConCase cn i ns (prune proj sc)

509 where pruneAlt (ConCase cn i ns sc) = ConCase cn i ns (prune proj sc)

506 pruneAlt (FnCase cn ns sc) = FnCase cn ns (prune proj sc)

510 pruneAlt (FnCase cn ns sc) = FnCase cn ns (prune proj sc)

src/IRTS/Compiler.hs+5−5

@@ -352,10 +352,10 @@ instance ToIR SC where

352

353 ir' (STerm t) = ir t

354 ir' (UnmatchedCase str) = return $ LError str

355+ ir' (ProjCase tm alts) = do tm' <- ir tm

355− ir' (ProjCase tm alts) = do alts' <- mapM (mkIRAlt tm) alts

356+ alts' <- mapM (mkIRAlt tm') alts

356− tm' <- ir tm

357 return $ LCase tm' alts'

358− ir' (Case n alts) = do alts' <- mapM (mkIRAlt (P Bound n Erased)) alts

358+ ir' (Case n alts) = do alts' <- mapM (mkIRAlt (LV (Glob n))) alts

359 return $ LCase (LV (Glob n)) alts'

360 ir' ImpossibleCase = return LNothing

361

@@ -379,10 +379,10 @@ instance ToIR SC where

379 | matchableTy x

380 = do rhs' <- ir rhs

381 return $ LDefaultCase rhs'

382− mkIRAlt (P _ orig _) (SucCase n rhs)

382+ mkIRAlt tm (SucCase n rhs)

383 = do rhs' <- ir rhs

384 return $ LDefaultCase (LLet n (LOp (LMinus (ATInt ITBig))

385− [LV (Glob orig),

385+ [tm,

386 LConst (BI 1)]) rhs')

387-- return $ LSucCase n rhs'

388 mkIRAlt _ (ConstCase c rhs)