haga/lib/LambdaCalculus.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

module LambdaCalculus where

import Data.List (foldr1, intersect, last, nub, (!!), (\\))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Random
import qualified Data.Text as T
import Data.Tuple.Extra
import Data.Typeable
import Debug.Trace as DB
import GA
import Pretty
import Protolude
import Protolude.Error
import Test.QuickCheck hiding (sample, shuffle)
import Test.QuickCheck.Monadic (assert, monadicIO)
import qualified Type.Reflection as Ref
import Utils

data ExpressionWeights = ExpressionWeights
  { lambdaSpucker :: Int,
    lambdaSchlucker :: Int,
    symbol :: Int,
    variable :: Int,
    constant :: Int
  }

data LambdaEnviroment = LambdaEnviroment
  { functions :: (Map TypeRep [ConVal]),
    constants :: (Map TypeRep [RVar ConVal]),
    targetType :: TypeRep,
    maxDepth :: Int,
    weights :: ExpressionWeights
  }

showSanifid :: (Show a) => a -> Text
showSanifid var = T.replace " -> " "To" (show var)

exampleLE :: LambdaEnviroment
exampleLE =
  LambdaEnviroment
    { functions =
        Map.fromList
          [ ((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int))), ["(+)", "(-)", "(*)", "mod"]),
            ((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Bool))), ["(>)", "(==)", "(>=)"]),
            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Int -> Int -> Int))), ["if'"])
          ],
      constants =
        Map.fromList
          [ ((Ref.SomeTypeRep (Ref.TypeRep @(Int))), [(fmap show (uniform 0 10000 :: RVar Int))]),
            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool))), [(fmap show (uniform True False :: RVar Bool))])
          ],
      targetType = (Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int))),
      maxDepth = 10,
      weights =
        ExpressionWeights
          { lambdaSpucker = 1,
            lambdaSchlucker = 2,
            symbol = 2,
            variable = 10,
            constant = 2
          }
    }

type BoundVars = [TypeRep]

-- we need a dynamic typ with a concept of equality here, should we want to interpret the result, instead of compiling it...
type ConVal = Text

-- LambdaSpucker - adds TypeRequester#1 as bound var and returns the result of TypeRequester#2

data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show)

asList :: LambdaExpression -> [TypeRequester]
asList (LambdaSpucker tr1 tr2 _) = [tr1, tr2]
asList (LambdaSchlucker tr _) = [tr]
asList (Symbol _ trs _) = trs
asList (Var _ _ trs _) = trs
asList (Constan _) = []

data TypeRequester = TR TypeRep (Maybe LambdaExpression) BoundVars deriving (Eq, Ord, Show)

toLambdaExpressionS :: TypeRequester -> Text
toLambdaExpressionS (TR typeRep (Just lambdaExpression) boundVars) = "((" <> eToLambdaExpressionS lambdaExpression <> ") :: (" <> show typeRep <> "))"
toLambdaExpressionS (TR _ (Nothing) _) = "Invalid Lambda Epr"

-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show)

eToLambdaExpressionS :: LambdaExpression -> Text
eToLambdaExpressionS (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionS typeRequester2 <> ") " <> toLambdaExpressionS typeRequester1
eToLambdaExpressionS (LambdaSchlucker typeRequester boundVars) = "\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionS typeRequester
eToLambdaExpressionS (Symbol (valS) typeRequesters _) = valS <> " " <> (unwords (map toLambdaExpressionS typeRequesters))
eToLambdaExpressionS (Var typeRep int typeRequesters _) = "l" <> showSanifid typeRep <> show int <> " " <> (unwords (map toLambdaExpressionS typeRequesters))
eToLambdaExpressionS (Constan (valS)) = valS

instance Pretty TypeRequester where
  pretty = toLambdaExpressionShort

instance Individual TypeRequester

instance Pretty LambdaEnviroment where
  pretty (LambdaEnviroment functions constants target _ _) = "Functions: " <> show functions <> " Constants: " <> show (Map.keys constants) <> " Target is a function: " <> show target

genTypeRequester :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar TypeRequester
genTypeRequester env depthLeft target boundVars = do
  le <- genLambdaExpression env (depthLeft - 1) target boundVars
  return (TR target (Just le) boundVars)

genLambdaExpression :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaExpression env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  let weightMap =
        ( if not (canGenSchlucker target)
            then [(constant weights, genLambdaConst env depthLeft target boundVar)]
            else []
        )
          <> ( if depthLeft > 0
                 then [(lambdaSpucker weights, genLambdaSpucker env depthLeft target boundVar)]
                 else []
             )
          <> ( if canGenSchlucker target
                 then [(lambdaSchlucker weights, genLambdaSchlucker env depthLeft target boundVar)]
                 else []
             )
          <> ( if depthLeft > 0 && doAnyMatchThatType target (Map.keys functions)
                 then [(symbol weights, genLambdaSymbol env depthLeft target boundVar)]
                 else []
             )
          <> ( if depthLeft > 0 && doAnyMatchThatType target boundVar
                 then [(variable weights, genLambdaVar env depthLeft target boundVar)]
                 else []
             )
  expres <- selectWeighted weightMap
  res <- expres
  return res

selectWeighted :: [(Int, a)] -> RVar a
selectWeighted x = do
  let total = sum (map fst x)
  selection <- uniform 1 total
  return $ selectAtWeight selection (NE.fromList x)

selectAtWeight :: Int -> NonEmpty (Int, a) -> a
selectAtWeight _ (x :| []) = snd x
selectAtWeight w (x :| xs)
  | fst x >= w = snd x
  | otherwise = selectAtWeight (w - fst x) (NE.fromList xs)

canGenSchlucker :: TypeRep -> Bool
canGenSchlucker t = (typeRepTyCon t) == (typeRepTyCon (Ref.SomeTypeRep (Ref.TypeRep @(->))))

doAnyMatchThatType :: TypeRep -> [TypeRep] -> Bool
doAnyMatchThatType toGen available = any (doTypesMatch toGen) available

doTypesMatch :: TypeRep -> TypeRep -> Bool
doTypesMatch toGen available = elem toGen (available : (repeatedly (lastMay . typeRepArgs) available))

genLambdaSpucker :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaSpucker env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  lamdaTypeLength <- uniform 1 4
  lambaTypes <- replicateM lamdaTypeLength (randomElement (Map.keys constants))
  let lambaType = foldr1 mkFunTy lambaTypes
  lamdaVarTypeRequester <- genTypeRequester env depthLeft lambaType boundVar
  typeRequester <- genTypeRequester env depthLeft target (boundVar ++ [lambaType])
  return (LambdaSpucker lamdaVarTypeRequester typeRequester (boundVar ++ [lambaType]))

genLambdaSchlucker :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaSchlucker env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  let args = typeRepArgs target
  let lambaType = fromJust (head args)
  let toFind = last args
  typeRequester <- genTypeRequester env (depthLeft + 1) toFind (boundVar ++ [lambaType])
  return (LambdaSchlucker typeRequester (boundVar ++ [lambaType]))

genLambdaConst :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaConst env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  elm <- randomElement $ fromJust (Map.lookup target constants)
  res <- elm
  return $ Constan res

genLambdaSymbol :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaSymbol env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  let availFunTypes = filter (doTypesMatch target) (Map.keys functions)
  (tr, fun) <- randomElement $ concatMap (\l -> zip (repeat l) (fromMaybe [] (Map.lookup l functions))) availFunTypes
  ret <- genLambdaSymbol' tr fun [] env depthLeft target boundVar
  return ret

genLambdaSymbol' :: TypeRep -> ConVal -> [TypeRequester] -> LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaSymbol' tr v trs env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar
  | tr == target = do
      return $ Symbol v trs boundVar
  | otherwise = do
      let args = typeRepArgs tr
      let param = fromJust (head args)
      let rest = last args
      newTypeRequ <- genTypeRequester env depthLeft param boundVar
      ret <- genLambdaSymbol' rest v (trs ++ [newTypeRequ]) env depthLeft target boundVar
      return ret

genLambdaVar :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaVar env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
  let availTypes = filter (doTypesMatch target) boundVar
  choosenType <- randomElement $ availTypes
  let tCount = count boundVar choosenType
  indexV <- uniform 0 (tCount - 1)
  ret <- genLambdaVar' choosenType choosenType indexV [] env depthLeft target boundVar
  return ret

genLambdaVar' :: TypeRep -> TypeRep -> Int -> [TypeRequester] -> LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
genLambdaVar' tr varType varNumber trs env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar
  | tr == target = do
      return $ Var varType varNumber trs boundVar
  | otherwise = do
      let args = typeRepArgs tr
      let param = fromJust (head args)
      let rest = last args
      newTypeRequ <- genTypeRequester env depthLeft param boundVar
      ret <- genLambdaVar' rest varType varNumber (trs ++ [newTypeRequ]) env depthLeft target boundVar
      return ret

instance Environment TypeRequester LambdaEnviroment where
  new env@(LambdaEnviroment _ _ target maxDepth _) = do
    tr <- genTypeRequester env maxDepth target []
    return tr

  mutate env@(LambdaEnviroment _ _ _ maxDepth _) tr = do
    selfCrossover <- uniform True False
    co <- crossover1 env tr tr
    if selfCrossover && isJust co
      then do
        let (tr1, tr2) = fromJust co
        return $ minimumBy (compare `on` countTrsR) [tr1, tr2]
      else do
        let trCount = countTrsR (tr)
        selectedTR <- uniform 1 trCount
        let (depthAt, (TR trep _ bound)) = depthLeftAndTypeAtR tr selectedTR maxDepth
        res <- genTypeRequester env depthAt trep bound
        return $ replaceAtR selectedTR tr res

  nX _ = 3 -- todo!

  crossover1 env@(LambdaEnviroment _ _ _ maxDepth _) tr1 tr2 = do
    let trCount = countTrsR tr1
    selectedIndex1 <- uniform 1 trCount
    let (depthAt1, selectedTr1@(TR _ _ bound1)) = depthLeftAndTypeAtR tr1 selectedIndex1 maxDepth
    let depthLeftNeeded = depthOfTR selectedTr1
    let indexes = findIndicesWhere tr2 (isCompatibleTr selectedTr1 (maxDepth - depthAt1) depthLeftNeeded) 0 0
    if length indexes == 0
      then return Nothing
      else
        ( do
            (selectedTr2@(TR _ _ bound2), selectedIndex2) <- randomElement indexes
            selectedTr2 <- adaptBoundVars selectedTr2 bound1
            selectedTr1 <- adaptBoundVars selectedTr1 bound2
            let child1 = replaceAtR selectedIndex1 tr1 selectedTr2
            let child2 = replaceAtR selectedIndex2 tr2 selectedTr1
            return $ Just (child1, child2)
        )

-- helper
depthOfTR :: TypeRequester -> Int
depthOfTR (TR _ (Just le@(LambdaSchlucker _ _)) _) = maximum (0:(map depthOfTR (asList le)))
depthOfTR (TR _ (Just le) _) = maximum (0:(map depthOfTR (asList le))) + 1
depthOfTR _ = error "le Not Just (depthOfTR)"

adaptBoundVars :: TypeRequester -> BoundVars -> RVar TypeRequester
adaptBoundVars tr@(TR _ _ bvOld) bvNew = do
  newIndexMap <- generateConversionIndexMap bvOld bvNew
  return $ convertTr tr bvOld bvNew newIndexMap

convertTr :: TypeRequester -> BoundVars -> BoundVars -> Map TypeRep (Int -> Int) -> TypeRequester
convertTr tr@(TR tRp (Just le) bvCurr) bvOld bvNew mapper = TR tRp (Just (convertLe le bvOld bvNew mapper)) (bvNew ++ (bvCurr \\ bvOld))
convertTr _ _ _ _ = error "le Not Just (convertTr)"

-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show)
convertLe :: LambdaExpression -> BoundVars -> BoundVars -> Map TypeRep (Int -> Int) -> LambdaExpression
convertLe (LambdaSpucker tr1 tr2 bvCurr) bvOld bvNew mapper = LambdaSpucker (convertTrf tr1) (convertTrf tr2) (bvNew ++ (bvCurr \\ bvOld))
  where
    convertTrf tr = convertTr tr bvOld bvNew mapper
convertLe (LambdaSchlucker tr bvCurr) bvOld bvNew mapper = LambdaSchlucker (convertTrf tr) (bvNew ++ (bvCurr \\ bvOld))
  where
    convertTrf tr = convertTr tr bvOld bvNew mapper
convertLe (Symbol cv trs bvCurr) bvOld bvNew mapper = Symbol cv (map convertTrf trs) (bvNew ++ (bvCurr \\ bvOld))
  where
    convertTrf tr = convertTr tr bvOld bvNew mapper
convertLe (Var varType varNumber trs bvCurr) bvOld bvNew mapper = Var varType ((fromMaybe identity (Map.lookup varType mapper)) varNumber) (map convertTrf trs) (bvNew ++ (bvCurr \\ bvOld))
  where
    convertTrf tr = convertTr tr bvOld bvNew mapper
convertLe le@(Constan _) _ _ _ = le

generateConversionIndexMap :: BoundVars -> BoundVars -> RVar (Map TypeRep (Int -> Int))
generateConversionIndexMap bvOld bvNew = do
  funcs <- mapM (\bT -> genMapper (count bvOld bT - 1) (count bvNew bT - 1)) (nub bvOld)
  return $ Map.fromList $ zip (nub bvOld) funcs

genMapper :: Int -> Int -> RVar (Int -> Int)
genMapper i j
  | i == j = return identity
  | i < j = return $ \int -> if int <= i then int else int + (j - i)
  | i > j = do
      permutationForUnbound <- genPermutation i j
      return $ genMapperRandomAssment i j permutationForUnbound
  | otherwise = error "impossible case in genMapper"

genMapperRandomAssment :: Int -> Int -> [Int] -> Int -> Int
genMapperRandomAssment i j permutationForUnbound int
  | int <= j = int
  | int > i = int - (i - j)
  | otherwise = permutationForUnbound !! (int - j - 1)

genPermutation :: Int -> Int -> RVar [Int]
genPermutation i j = replicateM (i - j) (uniform 0 j)

isCompatibleTr :: TypeRequester -> Int -> Int -> TypeRequester -> Int -> Bool
isCompatibleTr tr1@(TR trep1 _ bound1) maxDepthOfTR2 maxDepthOfNode tr2@(TR trep2 _ bound2) depthOfNode
  | trep1 == trep2 = allUsedBound (usedVars bound1 tr1) bound2 && allUsedBound (usedVars bound2 tr2) bound1 && maxDepthOfTR2 >= (depthOfTR tr2) && maxDepthOfNode >= depthOfNode
  | otherwise = False

allUsedBound :: BoundVars -> BoundVars -> Bool
allUsedBound used available = all (\x -> any (== x) available) used

usedVars :: BoundVars -> TypeRequester -> BoundVars
usedVars boundOld tr@(TR trep1 (Just (Var trp ind trs _)) _) = if any (== trp) boundOld && count boundOld trp > ind then trp : concatMap (usedVars boundOld) trs else concatMap (usedVars boundOld) trs
usedVars boundOld tr@(TR trep1 (Just le) _) = concatMap (usedVars boundOld) (asList le)
usedVars _ _ = error "Nothing in usedVars"

boundsConvertable :: BoundVars -> BoundVars -> Bool
boundsConvertable bv1 bv2 = length (nub bv2) == length (nub bv1) && length (intersect (nub bv1) bv2) == length (nub bv1)

findIndicesWhere :: TypeRequester -> (TypeRequester -> Int -> Bool) -> Int -> Int -> [(TypeRequester, Int)]
findIndicesWhere tr@(TR _ (Just le@(LambdaSchlucker _ _)) _) filte indx currDepth = if filte tr currDepth then (tr, indx + 1) : (findIndicesWhere' (asList le) filte (indx + 1) (currDepth)) else (findIndicesWhere' (asList le) filte (indx + 1) (currDepth))
findIndicesWhere tr@(TR _ lE _) filte indx currDepth = case lE of
  Just le -> if filte tr currDepth then (tr, indx + 1) : (findIndicesWhere' (asList le) filte (indx + 1) (currDepth + 1)) else (findIndicesWhere' (asList le) filte (indx + 1) (currDepth + 1))
  Nothing -> error "Nothing in findIndicesWhere"

findIndicesWhere' :: [TypeRequester] -> (TypeRequester -> Int -> Bool) -> Int -> Int -> [(TypeRequester, Int)]
findIndicesWhere' [] _ _ _ = []
findIndicesWhere' [tr] f indx currDepth = (findIndicesWhere tr f indx currDepth)
findIndicesWhere' (tr : trs) f indx currDepth = (findIndicesWhere tr f indx currDepth) ++ (findIndicesWhere' trs f (indx + countTrsR tr) currDepth)

replaceAtR :: Int -> TypeRequester -> TypeRequester -> TypeRequester
replaceAtR 1 _ with = with
replaceAtR i (TR tm (Just le) bV) with = TR tm (Just (replaceAt (i - 1) le with)) bV
replaceAtR _ (TR _ Nothing _) _ = error "Nothing in replaceAtR"

replaceAt :: Int -> LambdaExpression -> TypeRequester -> LambdaExpression
replaceAt i le@(LambdaSpucker _ _ bv) with = LambdaSpucker (fromJust (head trs)) (last trs) bv where trs = replaceInSubtreeWithIndex i (asList le) with
replaceAt i (LambdaSchlucker tr bv) with = LambdaSchlucker (replaceAtR i tr with) bv
replaceAt i le@(Symbol cv _ bv) with = Symbol cv trs bv where trs = replaceInSubtreeWithIndex i (asList le) with
replaceAt i le@(Var tr ix _ bv) with = Var tr ix trs bv where trs = replaceInSubtreeWithIndex i (asList le) with
replaceAt _ (Constan _) _ = error "Nothing in replaceAt"

replaceInSubtreeWithIndex :: Int -> [TypeRequester] -> TypeRequester -> [TypeRequester]
replaceInSubtreeWithIndex indexLeft (tr : trs) with = if countTrsR tr >= indexLeft then (replaceAtR indexLeft tr with) : trs else tr : (replaceInSubtreeWithIndex (indexLeft - countTrsR tr) trs with)
replaceInSubtreeWithIndex _ [] _ = error "Index not found in replaceInSubtreeWithIndex"

depthLeftAndTypeAtR :: TypeRequester -> Int -> Int -> (Int, TypeRequester)
depthLeftAndTypeAtR t 1 depthLeft = ((depthLeft - 1), t)
depthLeftAndTypeAtR (TR _ (Just le) _) indexLeft depthLeft = depthLeftAndTypeAt le (indexLeft - 1) (depthLeft - 1)
depthLeftAndTypeAtR (TR _ Nothing _) indexLeft depthLeft = error "Nothing in depthLeftAndTypeAtR"

depthLeftAndTypeAt :: LambdaExpression -> Int -> Int -> (Int, TypeRequester)
depthLeftAndTypeAt le@(LambdaSchlucker tr bv) indexLeft depthLeft = depthLeftAndTypeInSubtreeWithIndex (asList le) indexLeft (depthLeft + 1)
depthLeftAndTypeAt le indexLeft depthLeft = depthLeftAndTypeInSubtreeWithIndex (asList le) indexLeft depthLeft

depthLeftAndTypeInSubtreeWithIndex :: [TypeRequester] -> Int -> Int -> (Int, TypeRequester)
depthLeftAndTypeInSubtreeWithIndex (tr : trs) indexLeft depthLeft = if countTrsR tr >= indexLeft then depthLeftAndTypeAtR tr indexLeft depthLeft else depthLeftAndTypeInSubtreeWithIndex trs (indexLeft - countTrsR tr) depthLeft
depthLeftAndTypeInSubtreeWithIndex [] indexLeft depthLeft = error "Index not found in depthLeftAndTypeInSubtreeWithIndex"

countTrsR :: TypeRequester -> Int
countTrsR tr@(TR t lE _) = case lE of
  Just le -> countTrs le + 1
  Nothing -> 1

countTrs :: LambdaExpression -> Int
countTrs le = sum (map countTrsR (asList le))

-- Test Stuff

testConstInt :: TypeRequester
testConstInt = TR (Ref.SomeTypeRep (Ref.TypeRep @Int)) (Just (Symbol ("5") [] [])) []

testIntToClassCons :: TypeRequester
testIntToClassCons = TR (Ref.SomeTypeRep (Ref.TypeRep @(Int -> ResClass))) (Just (Symbol ("Class1") [] [])) []

testIntToClassCorrect :: TypeRequester
testIntToClassCorrect =
  TR
    (Ref.SomeTypeRep (Ref.TypeRep @(Int -> ResClass)))
    ( Just
        ( LambdaSchlucker
            ( TR
                (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                ( Just
                    ( Symbol
                        ("iteClass")
                        [ ( TR
                              (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
                              ( Just
                                  ( Symbol
                                      ("eqInt")
                                      [ ( TR
                                            (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                            (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                        ),
                                        ( TR
                                            (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                            (Just (Constan ("1")))
                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                        )
                                      ]
                                      [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                  )
                              )
                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                          ),
                          ( TR
                              (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                              (Just (Constan ("Class1")))
                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                          ),
                          ( TR
                              (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                              ( Just
                                  ( Symbol
                                      ("iteClass")
                                      [ ( TR
                                            (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
                                            ( Just
                                                ( Symbol
                                                    ("eqInt")
                                                    [ ( TR
                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                                          (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                      ),
                                                      ( TR
                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                                          (Just (Constan ("2")))
                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                      )
                                                    ]
                                                    [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                )
                                            )
                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                        ),
                                        ( TR
                                            (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                                            (Just (Constan ("Class2")))
                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                        ),
                                        ( TR
                                            (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                                            ( Just
                                                ( Symbol
                                                    ("iteClass")
                                                    [ ( TR
                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
                                                          ( Just
                                                              ( Symbol
                                                                  ("eqInt")
                                                                  [ ( TR
                                                                        (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                                                        (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
                                                                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                                    ),
                                                                    ( TR
                                                                        (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
                                                                        (Just (Constan ("3")))
                                                                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                                    )
                                                                  ]
                                                                  [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                              )
                                                          )
                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                      ),
                                                      ( TR
                                                          (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                                                          (Just (Constan ("Class3")))
                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                      ),
                                                      ( TR
                                                          (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
                                                          (Just (Constan ("Class3")))
                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                      )
                                                    ]
                                                    [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                                )
                                            )
                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                        )
                                      ]
                                      [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                                  )
                              )
                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                          )
                        ]
                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
                    )
                )
                [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
            )
            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
        )
    )
    []

data ResClass = Class1 | Class2 | Class3 deriving (Enum, Show)

eqInt :: Int -> Int -> Bool
eqInt a b = a == b

iteClass :: Bool -> ResClass -> ResClass -> ResClass
iteClass True c _ = c
iteClass False _ c = c

toLambdaExpressionShort :: TypeRequester -> Text
toLambdaExpressionShort (TR _ (Just lambdaExpression) _) = "(" <> eToLambdaExpressionShort lambdaExpression <> ")"
toLambdaExpressionShort (TR _ (Nothing) _) = "Invalid Lambda Epr"

-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int | Constan ConVal

eToLambdaExpressionShort :: LambdaExpression -> Text
eToLambdaExpressionShort (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester2 <> ") " <> toLambdaExpressionShort typeRequester1
eToLambdaExpressionShort (LambdaSchlucker typeRequester boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester <> ")"
eToLambdaExpressionShort (Symbol (valS) typeRequesters _) = valS <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
eToLambdaExpressionShort (Var typeRep int typeRequesters _) = "l" <> showSanifid typeRep <> show int <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
eToLambdaExpressionShort (Constan (valS)) = valS

res :: Int -> ResClass
res = ((\lInt0 -> ((iteClass ((eqInt ((lInt0) :: (Int)) ((1) :: (Int))) :: (Bool)) ((Class1) :: (ResClass)) ((iteClass ((eqInt ((lInt0) :: (Int)) ((2) :: (Int))) :: (Bool)) ((Class2) :: (ResClass)) ((iteClass ((eqInt ((lInt0) :: (Int)) ((3) :: (Int))) :: (Bool)) ((Class3) :: (ResClass)) ((Class3) :: (ResClass))) :: (ResClass))) :: (ResClass))) :: (ResClass))) :: (Int -> ResClass))