module DDC.Source.Tetra.Transform.Guards
( desugarGuards )
where
import DDC.Source.Tetra.Transform.BoundX
import DDC.Source.Tetra.Compounds
import DDC.Source.Tetra.Exp.Annot
import DDC.Type.Exp
desugarGuards
:: forall a
. GAnnot (Annot a)
-> [GGuardedExp (Annot a)]
-> GExp (Annot a)
-> GExp (Annot a)
desugarGuards a gs0 fail0
= go gs0 fail0
where
go [] cont
= cont
go [g] cont
= go1 g cont
go (g : gs) cont
= go1 g (go gs cont)
go1 (GExp x1) _
= x1
go1 (GGuard GDefault gs) cont
= go1 gs cont
go1 (GGuard (GPred g1) (GExp x1)) cont
= XCase a g1
[ AAlt pTrue [GExp x1]
, AAlt PDefault [GExp cont] ]
go1 (GGuard (GPat p1 g1) (GExp x1)) cont
= XCase a g1
[ AAlt p1 [GExp x1]
, AAlt PDefault [GExp cont]]
go1 (GGuard (GPred x1) gs) cont
= XLet a (LLet (BAnon (tBot kData)) (xBox a cont))
$ XCase a (liftX 1 x1)
[ AAlt pTrue [GExp (go1 (liftX 1 gs) (xRun a (XVar a (UIx 0))))]
, AAlt PDefault [GExp (xRun a (XVar a (UIx 0))) ]]
go1 (GGuard (GPat p1 x1) gs) cont
= XLet a (LLet (BAnon (tBot kData)) (xBox a cont))
$ XCase a (liftX 1 x1)
[ AAlt p1 [GExp (go1 (liftX 1 gs) (xRun a (XVar a (UIx 0))))]
, AAlt PDefault [GExp (xRun a (XVar a (UIx 0))) ]]