module CSharp.Analysis where

import CSharp.AbstractSyntax
import CSharp.Algebra
import Debug.Trace

data AnaRes = Error String | Fine

combine :: AnaRes-> AnaRes -> AnaRes
combine err@(Error s) _ = err
combine _ err@(Error s) = err
combine _ _ = Fine

type AnaEnv = [(Ident,RetType)]

analysisAlgebra :: CSharpAlgebra AnaRes (AnaEnv -> (AnaRes,AnaEnv)) (AnaEnv -> (AnaRes,AnaEnv)) (AnaEnv ->(AnaRes, RetType))
analysisAlgebra = CSharpAlgebra
  anaClass
  anaMemberD
  anaMemberM
  anaStatDecl
  anaStatExpr
  anaStatIf
  anaStatWhile
  anaStatReturn
  anaStatBlock
  anaExprLit
  anaExprVar
  anaExprOper
  anaExprFunc

anaClass _ ms = fst $ foldr f (Fine,[]) ms
  where
    f  s (res2,env)= (combine res1 res2, env')
      where
        (res1,env') = s env
  
anaMemberD _ env= (Fine,env)

anaMemberM rettype ident decls s env = (fst $ s env',(ident,rettype):env)
  where env' =map (\(Decl rettype' ident') ->(ident',rettype')) decls

anaStatDecl (Decl rettype ident) env = (Fine,(ident,rettype):env)
anaStatExpr e env = (fst (e env), env) 
anaStatIf e s1 s2 env = (foldr combine Fine [fst (e env),fst (s1 env),fst (s2 env)],env)
anaStatWhile e s env = (combine (fst (e env)) $ fst (s env),env)
anaStatReturn e env= (fst (e env),env)
anaStatBlock ss env = foldl f (Fine, env) ss
  where f (res,env') s = let (res',env'') = s env' in (combine res res',env'')
anaExprLit (LitInt _) = const (Fine,NV TyInt)
anaExprLit (LitBool _) = const (Fine,NV TyBool)
anaExprVar ident env = case lookup ident env of
                         Just type_ -> (Fine,type_)
                         otherwise -> (Error $ "Error: The variable \""++ident++"\" does not exist in the current scope",TyVoid)
anaExprOper op e1 e2 env = (combine (combine res1 res2) (anaOper op t1 t2), retType op t1 t2)
  where
    (res1,t1) = e1 env
    (res2,t2) = e2 env
    
    anaSame str t1' t2' | t1'==t2' = Fine
                        | otherwise = Error $ "Error: An "++str++" has to be between values of the same type"
    anaBoolAlg _ (NV TyBool) (NV TyBool) = Fine
    anaBoolAlg str _ _ = Error $ "Error: An "++str++" has to between two booleans"
    anaInt str (NV TyInt) (NV TyInt) = Fine
    anaInt str _ _ = Error $ "Error: An "++str++" has to between two integers"
    anaOper OpAnd = anaBoolAlg "and"
    anaOper OpEq = anaSame "equality"
    anaOper OpOr = anaBoolAlg "or"
    anaOper OpXor = anaBoolAlg "xor"
    anaOper OpAsg = anaSame "equality"
    anaOper OpNeq = anaSame "inequality"
    anaOper OpLeq = anaInt "less or equal inequality"
    anaOper OpLt = anaInt "less than inequality"
    anaOper OpGeq = anaInt "greater or equal inequality"
    anaOper OpGt = anaInt "greater than inequality"
    anaOper OpAdd = anaInt "addition"
    anaOper OpSub = anaInt "subtraction"
    anaOper OpMul = anaInt "multiplication"
    anaOper OpDiv = anaInt "division"
    anaOper OpMod = anaInt "modulo"


    alwaysBool _ _ = NV TyBool
    alwaysInt = const ( const (NV TyInt))
    retType :: Operator -> RetType -> RetType -> RetType
    retType OpEq _ _= NV TyBool
    retType OpOr _ _= NV TyBool
    retType OpXor _ _= NV TyBool
    retType OpAnd _ _= NV TyBool
    retType OpAsg t1 _ = t1
    retType OpNeq _ _= NV TyBool
    retType OpLeq _ _= NV TyBool
    retType OpLt _ _= NV TyBool
    retType OpGeq _ _= NV TyBool
    retType OpGt _ _= NV TyBool
    retType OpAdd _ _= NV TyInt
    retType OpSub _ _= NV TyInt
    retType OpMul _ _= NV TyInt
    retType OpDiv _ _= NV TyInt
    retType OpMod _ _= NV TyInt

anaExprFunc ident es env = 
  case lookup ident env of
    Just type_ -> (foldr combine Fine $ fst $ unzip $ map ($ env) es,type_)
    Nothing -> (Error $ "Error: The function "++ident++" does not exist",TyVoid)