-- Keel REC ja selle denotatsioonsemantika

data Term 
    = Num    Int 
    | Var    Int        -- argument on muutuja indeks (mingis keskkonnas)
    | Sum    Term Term
    | Diff   Term Term
    | Prod   Term Term
    | IfElse Term Term Term
    | FunApp Int [Term] -- esimene argument on funktsiooni indeks
    deriving Show

type Decl   = [Term]

sampleDecl :: Decl
sampleDecl = 
    [-- f1(x1, x2) = x1 + x2
     Sum (Var 1) (Var 2),
     
     -- f2(x1) = if x1 then 1 else x1 * f2(x1-1)
     IfElse (Var 1) (Num 1) 
        (Prod (Var 1) (FunApp 2 [Diff (Var 1) (Num 1)])),
     
     -- f3(x1) = if x1 then 1 else x1 * f3(x1-f4(0))
     IfElse (Var 1) (Num 1) 
        (Prod (Var 1) (FunApp 3 [Diff (Var 1) (FunApp 4 [Num 0]) ])),

     -- f4(x1) = if x1 then 1 else f3(x1)
     IfElse (Var 1) (Num 1) (FunApp 3 [Var 1]),
     
     -- f5() = f5()
     FunApp 5 [],
     
     -- konstant
     -- f6(x1) = 1
     Num 1
    ]

-- näitetermid
fact4   = FunApp 2 [Num 4]        -- f2(4)
fact4'  = FunApp 3 [Num 4]        -- f3(4)
problem = FunApp 6 [FunApp 5 []]  -- f6(f5())






--------------------------------------------------------------------------------
-- CALL-BY-VALUE

type EnvVA  = [Int]
type FEnvVA = [FunVA]
type FunVA  = [Int] -> Maybe Int

evalVA :: Term -> Decl -> Maybe Int
evalVA t d = tSemVA t (dSemVA d) []

--------------------------------------------------------------------------------
tSemVA :: Term -> FEnvVA -> EnvVA -> Maybe Int

tSemVA (Num n) _ _    = Just n
tSemVA (Var i) _ env = Just (nth i env)

tSemVA (Sum  t1 t2) fEnv env = (tSemVA t1 fEnv env) +! (tSemVA t2 fEnv env) 
tSemVA (Prod t1 t2) fEnv env = (tSemVA t1 fEnv env) *! (tSemVA t2 fEnv env) 
tSemVA (Diff t1 t2) fEnv env = (tSemVA t1 fEnv env) -! (tSemVA t2 fEnv env)
 
tSemVA (IfElse t0 t1 t2) fEnv env = 
    cond (tSemVA t0 fEnv env) (tSemVA t1 fEnv env) (tSemVA t2 fEnv env)
    
tSemVA (FunApp fIdx args) fEnv env = strictApp f ns 
    where f = nth fIdx fEnv
          ns = map tSemVA' args 
          tSemVA' = \t -> tSemVA t fEnv env

strictApp :: ([a] -> Maybe b) -> [Maybe a] -> Maybe b          
strictApp f vs = case unliftList vs of
    Just ns -> f ns
    Nothing -> Nothing

unliftList :: [Maybe a] -> Maybe [a]
unliftList [] = Just []
unliftList (Nothing:_) = Nothing
unliftList ((Just x):xs) = case (unliftList xs) of 
    Nothing -> Nothing
    Just uxs-> Just (x:uxs)

--------------------------------------------------------------------------------
dSemVA :: Decl -> FEnvVA
dSemVA decl = fEnv
    where fEnv = map makeFun decl
          makeFun t = \args -> tSemVA t fEnv args

--dSemVA decl = fix(fu)
--    where fu fEnv = map makeFun decl
--                    where makeFun t = \args -> tSemVA t fEnv args

-- 'fix' on defineeritud moodulis 'Control.Monad.Fix':
-- fix :: (a -> a) -> a
-- fix f = f (fix f)








--------------------------------------------------------------------------------
-- CALL-BY-NAME

type EnvNA  = [Maybe Int]
type FEnvNA = [FunNA]
type FunNA  = [Maybe Int] -> Maybe Int

evalNA :: Term -> Decl -> Maybe Int
evalNA t d = tSemNA t (dSemNA d) []

tSemNA :: Term -> FEnvNA -> EnvNA -> Maybe Int
tSemNA (Num n) _ _    = Just n
tSemNA (Var i) _ env = nth i env -- "Just" tuleb juba keskkonnast
tSemNA (Sum  t1 t2) fEnv env = (tSemNA t1 fEnv env) +! (tSemNA t2 fEnv env) 
tSemNA (Prod t1 t2) fEnv env = (tSemNA t1 fEnv env) *! (tSemNA t2 fEnv env) 
tSemNA (Diff t1 t2) fEnv env = (tSemNA t1 fEnv env) -! (tSemNA t2 fEnv env)
tSemNA (IfElse t0 t1 t2) fEnv env = 
    cond (tSemNA t0 fEnv env) (tSemNA t1 fEnv env) (tSemNA t2 fEnv env)
tSemNA (FunApp fIdx args) fEnv env = f ns -- tavaline (laisk) rakendamine 
    where f = nth fIdx fEnv
          ns = map tSemNA' args 
          tSemNA' = \t -> tSemNA t fEnv env
          
dSemNA :: Decl -> FEnvNA
dSemNA decl = fEnv
    where fEnv = map (\t -> \args -> tSemNA t fEnv args) decl






--------------------------------------------------------------------------------
-- ABIFUNKTSIOONID

(+!) :: Maybe Int -> Maybe Int -> Maybe Int
Just a +! Just b = Just (a + b)
_ +! _ = Nothing

(*!) :: Maybe Int -> Maybe Int -> Maybe Int
Just a *! Just b = Just (a * b)
_ *! _ = Nothing

(-!) :: Maybe Int -> Maybe Int -> Maybe Int
Just a -! Just b = Just (a - b)
_ -! _ = Nothing

cond :: Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int
cond (Just 0) (Just n1) _ = Just n1
cond (Just _) _ (Just n2) = Just n2
cond _ _ _                = Nothing 



nth n list = head (drop (n-1) list)