ReferenceSemantics

-- | PIPLInterpreter: big step operational semantics of PIPL
-- using environment and store for the state.

module PIPLInterpreter where

import BIPL3AST
import PIPLMeta
import qualified BIPL3State as S
import BIPL3State (Value(..), State)
import BIPL3MetaTypes

type FunModel = FunName -> [Value] -> Value

type ExecutionModel = (FunModel, Program)

getFunModel :: ExecutionModel -> FunModel
getFunModel = fst

getProgram :: ExecutionModel -> Program
getProgram = snd

-- ///////// EVALUATE EXPRESSIONS ////////////////

eval :: Expr -> FunModel -> State -> Value
eval (IL i) _ state = I (fromIntegral i)
eval (BL b) _ state= B b
eval (VarExp var) _ state = S.getValue var state
eval (CallFun op args) funModel state =
    funModel op $ map (\expr -> eval expr funModel state) args

-- ///////// EXECUTE STATEMENTS ////////////////

exec :: Stmt -> ExecutionModel -> State -> State
exec (Assert expr) (funModel, _) state =
  if cond
    then state
    else error $ "Assert failed for " ++ (show expr)
      ++ " in state " ++ (show state)
  where
    B cond = eval expr funModel state
exec (Assign var expr) (funModel, _) state = S.changeValue var val state
  where val = eval expr funModel state
exec wstmt@(While expr stmt) execModel@(funModel, _) state = state' where
  B cond = eval expr funModel state
  state' = if cond then exec wstmt execModel (exec stmt execModel state) else state
exec (IfStmt expr stmt1 stmt2) execModel@(funModel, _) state = state' where
  B cond = eval expr funModel state
  state' = if cond then exec stmt1 execModel state else exec stmt2 execModel state
exec seq@(Sequence (stmt:stmts)) execModel state =
  exec (Sequence stmts) execModel (exec stmt execModel state)
exec seq@(Sequence []) execModel state = state
exec (CallProc pName args) execModel@(funModel, program) state =
  let
    olderStackFrame :: S.StackFrame
    olderStackFrame = S.getStackFrame state

    calledProc ::ProcedureDeclaration
    calledProc = getProc pName program

    --evaluatedValues :: [Value]
    --evaluatedValues = map (\arg -> eval arg funModel state) args
    modifiedState:: State
    --modifiedState = addCallStateInputs (procParams calledProc) evaluatedValues $ S.clearEnvironment state
    modifiedState = addCallStateInputsRef funModel (procParams calledProc) args  state $ S.clearEnvironment state

    afterPerformState :: State
    afterPerformState = perform calledProc execModel modifiedState
    {-


    values :: [Value]
    values = getReturnStateOutputs (procParams calledProc) afterPerformState

    matchedParamsArgs :: [(Parameter, Expr)]
    matchedParamsArgs = (zip (procParams calledProc) args)

    outExprs :: [Expr]
    outExprs = map snd $ filter (\(p,a) -> (fst p) /= Obs) matchedParamsArgs


    varNames :: [Var]
    varNames  = filterVar outExprs

    filterVar:: [Expr] -> [Var]
    filterVar ((VarExp var):exs) = var:filterVar exs
    filterVar (_:exs) = filterVar exs
    filterVar [] = []




    finalState :: State
    finalState =
      foldl
      (\s (vn, v) -> S.changeValue vn v s)
      oldEnvState (zip varNames values)
      -}
    oldEnvState :: State
    oldEnvState = S.setStackFrame olderStackFrame afterPerformState
  in oldEnvState


-- ///////// RUN PROGRAMS ////////////////

-- | Run a given procedure in the given program, while passing in the given
-- | values as arguments. Returns the values of the output parameters (upd/out)
-- | after the procedure has been run.
runProgram :: ExecutionModel -> ProcName -> [Value] -> [Value]
runProgram execModel@(funModel, prog) pName args =
  let proc@(Proc _ params _ _) = getProc pName prog
   in run proc execModel args

run :: ProcedureDeclaration -> ExecutionModel -> [Value] -> [Value]
run proc@(Proc _ params locals body) execModel args =
    let state = addCallStateInputs params args S.newState
        state' = perform proc execModel state
     in getReturnStateOutputs params state'

perform :: ProcedureDeclaration -> ExecutionModel -> State -> State
perform (Proc _ params locals body) prog state =
    let oldStackFrame = S.getStackFrame state
        stateWithLocals = addUninitVars (map varName locals) state
        stateAfterExec = exec body prog stateWithLocals
        stateAfterCleanup = S.setStackFrame oldStackFrame stateAfterExec
     in stateAfterCleanup

-- ///////// UTILITY FUNCTIONS ////////////////

-- | Add a list of variable names to the state, without initialising them.
addUninitVars :: [Var] -> State -> State
addUninitVars varNames initState = foldl addVar initState varNames
    where addVar state varName = S.allocateVariable varName state

addCallStateInputs :: [Parameter] -> [Value] -> State -> State
addCallStateInputs params args =
    let inputVars = getParamNames $ filter isInputParameter params
        outModeVars = getParamNames $ filter (not . isInputParameter) params
        isInputParameter (mode, _) = mode /= Out
        getParamNames = map (varName . paramVar)
        addVar state (varName, value) = S.addVariable varName value state
        addVars varNames values initState = foldl addVar initState (zip varNames values)
     in addUninitVars outModeVars . addVars inputVars args

getReturnStateOutputs :: [Parameter] -> State -> [Value]
getReturnStateOutputs params state =
    let outputVars = getParamNames $ filter isOutputParameter params
        isOutputParameter (mode, _) = mode /= Obs
        getParamNames = map (varName . paramVar)
     in map (\varName -> S.getValue varName state) outputVars


-- | Reference Semantics
addCallStateInputsRef ::  FunModel -> [Parameter] -> [Expr] -> State -> State -> State
addCallStateInputsRef funModel params args srcState state =
    let
      getParamName = (varName . paramVar)

      copyVars :: [(Var, Value)]
      copyVars = map (\(p, a) -> ((getParamName p), (eval a funModel srcState ))) $ filter isObsParam paramsWithArgs

      refModeVars :: [(Var, Var)]
      refModeVars = map (\(p, a) -> ((getParamName p), (findVar a))) $ filter (not . isObsParam) paramsWithArgs
       where
         findVar :: Expr -> Var
         findVar (VarExp varName) = varName
         findVar _ = error "Expected VarExp"

      isObsParam :: (Parameter, Expr) -> Bool
      isObsParam ((mode, _),_) = mode == Obs

      paramsWithArgs :: [(Parameter, Expr)]
      paramsWithArgs = zip params args

      addVar :: State -> (Var, Value) -> State
      addVar state (varName, value) = S.addVariable varName value state

      addVars :: [(Var, Value)] -> State -> State
      addVars vvs initState = foldl addVar initState vvs

     in addVars copyVars $ addVarsRef refModeVars srcState state

-- | Add a list of variable names to the state, without initialising them.
addVarsRef :: [(Var, Var)] -> State-> State -> State
addVarsRef varNames srcState initState = foldl addVar initState varNames
    where
      addVar :: State -> (Var, Var) -> State
      addVar  desState (varName, aliasName) = S.copyReference aliasName varName srcState desState