-- | 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