module Parsley.Internal.Core.Lam (normaliseGen, Lam(..)) where
import Parsley.Internal.Common.Utils (Code)
data Lam a where
Abs :: (Lam a -> Lam b) -> Lam (a -> b)
App :: Lam (a -> b) -> Lam a -> Lam b
Var :: Bool -> Code a -> Lam a
If :: Lam Bool -> Lam a -> Lam a -> Lam a
Let :: Lam a -> (Lam a -> Lam b) -> Lam b
T :: Lam Bool
F :: Lam Bool
normalise :: Lam a -> Lam a
normalise :: Lam a -> Lam a
normalise Lam a
x = Lam a -> Lam a
forall a. Lam a -> Lam a
reduce Lam a
x
where
reduce :: Lam a -> Lam a
reduce :: Lam a -> Lam a
reduce Lam a
x
| Lam a -> Bool
forall a. Lam a -> Bool
normal Lam a
x = Lam a
x
| Bool
otherwise = Lam a -> Lam a
forall a. Lam a -> Lam a
reduce (Lam a -> Lam a
forall a. Lam a -> Lam a
reduceStep Lam a
x)
reduceStep :: Lam a -> Lam a
reduceStep :: Lam a -> Lam a
reduceStep (App (Abs Lam a -> Lam b
f) Lam a
x) = Lam a -> Lam b
f Lam a
Lam a
x
reduceStep (App Lam (a -> a)
f Lam a
x)
| Lam (a -> a) -> Bool
forall a. Lam a -> Bool
normal Lam (a -> a)
f = Lam (a -> a) -> Lam a -> Lam a
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (a -> a)
f (Lam a -> Lam a
forall a. Lam a -> Lam a
reduceStep Lam a
x)
| Bool
otherwise = Lam (a -> a) -> Lam a -> Lam a
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (a -> a) -> Lam (a -> a)
forall a. Lam a -> Lam a
reduceStep Lam (a -> a)
f) Lam a
x
reduceStep (If Lam Bool
T Lam a
x Lam a
_) = Lam a
x
reduceStep (If Lam Bool
F Lam a
_ Lam a
y) = Lam a
y
reduceStep Lam a
x = Lam a
x
normal :: Lam a -> Bool
normal :: Lam a -> Bool
normal (App (Abs Lam a -> Lam b
_) Lam a
_) = Bool
False
normal (App Lam (a -> a)
f Lam a
x) = Lam (a -> a) -> Bool
forall a. Lam a -> Bool
normal Lam (a -> a)
f Bool -> Bool -> Bool
&& Lam a -> Bool
forall a. Lam a -> Bool
normal Lam a
x
normal (If Lam Bool
T Lam a
_ Lam a
_) = Bool
False
normal (If Lam Bool
F Lam a
_ Lam a
_) = Bool
False
normal Lam a
_ = Bool
True
generate :: Lam a -> Code a
generate :: Lam a -> Code a
generate (Abs Lam a -> Lam b
f) = [||\x -> $$(normaliseGen (f (Var True [||x||])))||]
generate (App Lam (a -> a)
f Lam a
x) = [||$$(generate f) $$(generate x)||]
generate (Var Bool
_ Code a
x) = Code a
x
generate (If Lam Bool
c Lam a
t Lam a
e) = [||if $$(normaliseGen c) then $$(normaliseGen t) else $$(normaliseGen e)||]
generate (Let Lam a
b Lam a -> Lam a
i) = [||let x = $$(normaliseGen b) in $$(normaliseGen (i (Var True [||x||])))||]
generate Lam a
T = [||True||]
generate Lam a
F = [||False||]
normaliseGen :: Lam a -> Code a
normaliseGen :: Lam a -> Code a
normaliseGen = Lam a -> Code a
forall a. Lam a -> Code a
generate (Lam a -> Code a) -> (Lam a -> Lam a) -> Lam a -> Code a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lam a -> Lam a
forall a. Lam a -> Lam a
normalise