Lam.hs

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 {- Simple -} -> 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 x = reduce x
  where
    reduce :: Lam a -> Lam a
    reduce x
      | normal x = x
      | otherwise = reduce (reduceStep x)

    reduceStep :: Lam a -> Lam a
    reduceStep (App (Abs f) x) = f x
    reduceStep (App f x)
      | normal f = App f (reduceStep x)
      | otherwise = App (reduceStep f) x
    reduceStep (If T x _) = x
    reduceStep (If F _ y) = y
    reduceStep x = x

    normal :: Lam a -> Bool
    normal (App (Abs _) _) = False
    normal (App f x) = normal f && normal x
    normal (If T _ _) = False
    normal (If F _ _) = False
    normal _ = True

generate :: Lam a -> Code a
generate (Abs f)    = [||\x -> $$(normaliseGen (f (Var True [||x||])))||]
-- These have already been reduced, since we only expose `normaliseGen`
generate (App f x)  = [||$$(generate f) $$(generate x)||]
generate (Var _ x)  = x
generate (If c t e) = [||if $$(normaliseGen c) then $$(normaliseGen t) else $$(normaliseGen e)||]
generate (Let b i)  = [||let x = $$(normaliseGen b) in $$(normaliseGen (i (Var True [||x||])))||]
generate T          = [||True||]
generate F          = [||False||]

normaliseGen :: Lam a -> Code a
normaliseGen = generate . normalise