{-# LANGUAGE ViewPatterns #-}

-- Evaluate/reduce a HSE Exp as much as possible
module HSE.Reduce(reduce) where

import HSE.Match
import HSE.Util
import HSE.Type
import Language.Haskell.Exts.Util


reduce :: Exp_ -> Exp_
reduce :: Exp_ -> Exp_
reduce = Exp_ -> Exp_
fromParen (Exp_ -> Exp_) -> (Exp_ -> Exp_) -> Exp_ -> Exp_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp_ -> Exp_) -> Exp_ -> Exp_
forall on. Uniplate on => (on -> on) -> on -> on
transform Exp_ -> Exp_
reduce1


reduce1 :: Exp_ -> Exp_
reduce1 :: Exp_ -> Exp_
reduce1 (App s :: S
s len :: Exp_
len (Lit _ (String _ xs :: String
xs _))) | Exp_
len Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "length" = S -> Literal S -> Exp_
forall l. l -> Literal l -> Exp l
Lit S
s (Literal S -> Exp_) -> Literal S -> Exp_
forall a b. (a -> b) -> a -> b
$ S -> Integer -> String -> Literal S
forall l. l -> Integer -> String -> Literal l
Int S
s Integer
n (Integer -> String
forall a. Show a => a -> String
show Integer
n)
    where n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs
reduce1 (App s :: S
s len :: Exp_
len (List _ xs :: [Exp_]
xs)) | Exp_
len Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "length" = S -> Literal S -> Exp_
forall l. l -> Literal l -> Exp l
Lit S
s (Literal S -> Exp_) -> Literal S -> Exp_
forall a b. (a -> b) -> a -> b
$ S -> Integer -> String -> Literal S
forall l. l -> Integer -> String -> Literal l
Int S
s Integer
n (Integer -> String
forall a. Show a => a -> String
show Integer
n)
    where n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp_]
xs
reduce1 (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op (Lit _ x :: Literal S
x) (Lit _ y :: Literal S
y)) | Exp_
op Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "==" = String -> Exp_
forall a. Named a => String -> a
toNamed (String -> Exp_) -> String -> Exp_
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ Literal S
x Literal S -> Literal S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Literal S
y
reduce1 (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op (Lit _ (Int _ x :: Integer
x _)) (Lit _ (Int _ y :: Integer
y _)))
    | Exp_
op Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= ">=" = String -> Exp_
forall a. Named a => String -> a
toNamed (String -> Exp_) -> String -> Exp_
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y
reduce1 (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op x :: Exp_
x y :: Exp_
y)
    | Exp_
op Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "&&" Bool -> Bool -> Bool
&& Exp_
x Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "True"  = Exp_
y
    | Exp_
op Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "&&" Bool -> Bool -> Bool
&& Exp_
x Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "False" = Exp_
x
reduce1 (Paren _ x :: Exp_
x) | Exp_ -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp_
x = Exp_
x
reduce1 x :: Exp_
x = Exp_
x