module APrims(evalAExprToInteger) where

import PPrint(ppReadable)
import ASyntax
import ASyntaxUtil
import Prim
import IntLit(IntLit(..))
import Util(separate)
import Error(ErrMsg)
import ErrorUtil(internalError)

-- import Debug.Trace


-- This is an evaluation function for AExprs on Integers.
-- It takes a value function which tries to determine an Integer
-- value for an identifier, and expression function which tries to find
-- an expression to compute the value for an identifier, and a method
-- function which gives a list of identifiers to look in for the value
-- of the method.  The function is quite limited and will return a
-- Left String containing a failure message in many cases.
evalAExprToInteger :: (AId -> Maybe Integer) -> (AId -> Maybe AExpr) ->
                      ((AId,AId) -> [AId]) ->
                      AExpr -> Either String Integer
evalAExprToInteger _ _ _ (ASInt _ _ lit) = Right (ilValue lit)
evalAExprToInteger valfn exprfn methfn (ASDef _ i) =
    case (valfn i) of
      (Just n) -> Right n
      Nothing  -> -- def value is not available, so attempt
                  -- to reconstruct it from its AExpr
                  case (exprfn i) of
                    (Just e) -> evalAExprToInteger valfn exprfn methfn e
                    Nothing  -> Left $ "unable to determine value of: " ++ (ppReadable i)
evalAExprToInteger valfn exprfn methfn e@(APrim _ _ op args) =
    let (errs,vs) = separate $ map (evalAExprToInteger valfn exprfn methfn) args
    in if (null errs)
       then evalPrim op (getOpSizes op e) vs
       else Left $ unlines errs
evalAExprToInteger valfn exprfn methfn e@(AMethCall t oid mid []) =
    let alts = [ ASDef t i | i <- methfn (oid,mid) ]
    in case (separate $ map (evalAExprToInteger valfn exprfn methfn) alts) of
         ([],(ok:_)) -> Right ok
         ([],[])     -> Left $ "Unable to resolve value of " ++ (ppReadable e)
         (errs,_)    -> Left $ unlines errs
evalAExprToInteger _ _ _ e = Left $ "evalAExprToInteger: cannot handle expression " ++
                                    (ppReadable e)

-- utilities for working with the return of primInts
use :: (a -> b) -> (Maybe (Either ErrMsg a)) -> PrimOp -> (Either String b)
use fn (Just (Right x)) _  = Right (fn x)
use _  (Just (Left s))  _  = Left (show s)
use _  Nothing          op = Left $ "evalPrim: no primitive function available for " ++ (show op)

asBool :: Bool -> Integer
asBool b = if b then 1 else 0

asInteger :: Integer -> Integer
asInteger = id

-- Select the return type based on the PrimOp
evalPrim :: PrimOp -> [Integer] -> [Integer] -> Either String Integer
evalPrim op ss vs | op `elem` boolOps
                  = use asBool (primResult op ss (map I vs)) op
evalPrim op ss vs = use asInteger (primResult op ss (map I vs)) op

-- See Prim.hs::evalIntPrimToBool
boolOps :: [PrimOp]
boolOps = [ PrimEQ, PrimULE, PrimULT, PrimSLE, PrimSLT
          , PrimBNot, PrimBAnd, PrimBOr
          , PrimIntegerEQ, PrimIntegerLE, PrimIntegerLT
          ]

-- An unused size, which will generate an error if it is ever actually used
unused :: Integer
unused = internalError "size parameter used unexpectedly"

-- Get the list of size parameters needed to evaluate a primitive.
-- These must match the patterns in Prim.hs
getOpSizes :: PrimOp -> AExpr -> [Integer]
getOpSizes PrimMul     e = [unused, unused, aSize e]
getOpSizes PrimQuot    e = [aSize e, unused]
getOpSizes PrimRem     e = [unused, aSize e]
getOpSizes PrimSL      e = [aSize e, unused]
getOpSizes PrimSRL     e = [aSize e, unused]
getOpSizes PrimSRA     e = [aSize e, unused]
getOpSizes PrimZeroExt _ = [unused, unused, unused]
getOpSizes PrimSignExt e = [unused, aSize ((ae_args e)!!0), aSize e]
getOpSizes PrimTrunc   e = [unused, aSize e, unused]
getOpSizes PrimExtract e = [aSize ((ae_args e)!!0), unused, aSize e]
getOpSizes PrimConcat  e = [aSize ((ae_args e)!!0), aSize ((ae_args e)!!1), aSize e]
getOpSizes PrimSelect  e = internalError $ "APrims: PrimSelect should not occur"
getOpSizes _           e = [aSize e]  -- by default just give the result size