g2-0.1.0.1: tests/GetNthTest.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module GetNthTest where

import G2.Language
import TestUtils

data CList a = Cons a (CList a) | Nil

data Peano = Succ Peano | Zero

getNth :: CList Integer -> Integer -> Integer
getNth (Cons x _)  0 = x 
getNth (Cons _ xs) n = getNth xs (n - 1)
getNth _      _ = -1

getNthErr :: CList a -> Integer -> Maybe a 
getNthErr (Cons x _)  0 = Just x 
getNthErr (Cons _ xs) n = getNthErr xs (n - 1)
getNthErr _      _ = Nothing

toCList :: Expr -> CList Integer
toCList (App (App (Data (DataCon (Name "Cons" _ _ _) _)) x) y) =
    getInt x Nil $ \x' -> Cons x' (toCList y)
toCList _ = Nil

toCListGen :: Expr -> CList Expr
toCListGen (App (App (Data (DataCon (Name "Cons" _ _ _) _)) e) y) =
    Cons e (toCListGen y)
toCListGen _ = Nil

toCListType :: Expr -> CList Integer
toCListType (App (App (App (Data (DataCon (Name "Cons" _ _ _) _)) (Type _)) x) y) =
    getInt x Nil $ \x' -> Cons x' (toCListType y)
toCListType _ = Nil

toCListGenType :: Expr -> CList Expr
toCListGenType (App (App (App (Data (DataCon (Name "Cons" _ _ _) _)) (Type _)) e) y) =
    Cons e (toCListGenType y)
toCListGenType _ = Nil

cListLength :: CList a -> Integer
cListLength (Cons _ xs) = 1 + cListLength xs
cListLength Nil = 0

getNthTest :: [Expr] -> Bool
getNthTest [cl, i, a] = getIntB i $ \i' -> getIntB a $ \a' -> getNth (toCList cl) i' == a'
getNthTest _ = False

getNthErrTest :: [Expr] -> Bool
getNthErrTest [cl, i, Prim Error _] = getIntB i $ \i' -> getNthErr (toCListType cl) i' == Nothing
getNthErrTest [cl, i, a] = getIntB i $ \i' -> getIntB a $ \a' -> getNthErr (toCListType cl) i' == Just a'
getNthErrTest _ = False

getNthErrGenTest :: [Expr] -> Bool
getNthErrGenTest [cl, i, Prim Error _] = getIntB i $ \i' -> getNthErr (toCListGenType cl) i' == Nothing
getNthErrGenTest [cl, i, e] =
    case getInt i Nothing $ \i' -> getNthErr (toCListGenType cl) i' of
        Just e' -> e' `eqIgT` e
        Nothing -> False
getNthErrGenTest _ = False

getNthErrGenTest' :: [Expr] -> Bool
getNthErrGenTest' [cl, i, Prim Error _] = getIntB i $ \i' -> getNthErr (toCListGenType cl) i' == Nothing
getNthErrGenTest' [cl, i, e] =
    case getInt i Nothing $ \i' -> getNthErr (toCListGenType cl) i' of
        Just e' -> e' `eqIgT` e
        Nothing -> False
getNthErrGenTest' _ = False

getNthErrGenTest2 :: [Expr] -> Bool
getNthErrGenTest2 [cl, i, Prim Error _] = getIntB i $ \i' -> getNthErr (toCListGenType cl) i' == Nothing
getNthErrGenTest2 [cl, i, e] =
    case getInt i Nothing $ \i' -> getNthErr (toCListGenType cl) i' of
        Just e' -> e' `eqIgT` e
        Nothing -> False
getNthErrGenTest2 _ = False

getNthErrGenTest2' :: [Expr] -> Bool
getNthErrGenTest2' [cl, i, Prim Error _] = getIntB i $ \i' -> getNthErr (toCListGenType cl) i' == Nothing
getNthErrGenTest2' [cl, i, e] =
    case getInt i Nothing $ \i' -> getNthErr (toCListGenType cl) i' of
        Just e' -> e' `eqIgT` e
        Nothing -> False
getNthErrGenTest2' _ = False

elimType :: (ASTContainer m Expr) => m -> m
elimType = modifyASTs elimType'

elimType' :: Expr -> Expr
elimType' (App e (Type _)) = e
elimType' e = e

getNthErrors :: [Expr] -> Bool
getNthErrors [cl, App _ (Lit (LitInt i)), Prim Error _] = getNthErr (toCListGen cl) i == Nothing
getNthErrors _ = False

cfmapTest :: [Expr] -> Bool
cfmapTest [_, e, e'] = cListLength (toCListGenType e) == cListLength (toCListGenType e') || isError e'
cfmapTest _ = False