diff options
Diffstat (limited to 'VM.hs')
| -rw-r--r-- | VM.hs | 34 |
1 files changed, 18 insertions, 16 deletions
@@ -60,7 +60,7 @@ vmRunBB info state (BB _ inss term) = do vmRunInstr :: Info -> State -> Instruction -> IO State -- vmRunInstr _ _ ins | traceShow ins False = undefined -vmRunInstr info@(Info bbmap gfds datas) state@(State { sTempMap = tmap, sArgs = args, sCloVals = closure }) (dest, instr) = case instr of +vmRunInstr info@(Info _ _ datas) state@(State { sTempMap = tmap, sArgs = args, sCloVals = closure }) (dest, instr) = case instr of IAssign ref -> return (assignRef state dest (findRef tmap ref)) IParam i -> if i < length args then return (assignRef state dest (args !! i)) @@ -71,21 +71,9 @@ vmRunInstr info@(Info bbmap gfds datas) state@(State { sTempMap = tmap, sArgs = IData i -> if i < length datas then return (assignRef state dest (toRunValue (datas !! i))) else error "data-out-of-range" - ICallC cl as -> - -- trace ("callc " ++ show (findRef tmap cl) ++ " " ++ show (map (findRef tmap) as)) $ - case findRef tmap cl of - RVClosure clname clvals -> case Map.lookup clname gfds of - Just (GlobFuncDef b _ _) -> - let Just bb = Map.lookup b bbmap - in do - -- traceM ("call " ++ show cl ++ " with arguments " ++ show (map (findRef tmap) as)) - (rv, _) <- vmRunBB info (state { sArgs = map (findRef tmap) as, sCloVals = clvals }) bb - return (assignRef state dest rv) - Nothing -> do - -- Take 'tail as' to skip the first self-link argument - (rv, state') <- vmRunBuiltin state clname (map (findRef tmap) (tail as)) - return (assignRef state' dest rv) - obj -> error $ "VM: Cannot call non-closure object: " ++ show obj + ICallC cl as -> do + (rv, state') <- callClosure info state cl as + return (assignRef state' dest rv) IAllocClo name clrefs -> return (assignRef state dest (RVClosure name (map (findRef tmap) clrefs))) IDiscard _ -> return state @@ -94,6 +82,7 @@ vmRunTerm info@(Info bbmap _ _) state@(State { sTempMap = tmap }) term = case te IBr ref b1 b2 -> vmRunBB info state . (bbmap !) $ if truthy (findRef tmap ref) then b1 else b2 IJmp b -> vmRunBB info state (bbmap ! b) IRet ref -> return (findRef tmap ref, state) + ITailC cl as -> callClosure info state cl as IExit -> IO.ioError (IO.userError kErrorExit) IUnknown -> undefined @@ -107,6 +96,19 @@ assignRef :: State -> Ref -> RunValue -> State assignRef state (RTemp i) rv = state { sTempMap = Map.insert i rv (sTempMap state) } assignRef _ ref _ = error $ "VM: Unexpected ref " ++ show ref ++ " assigned" +callClosure :: Info -> State -> Ref -> [Ref] -> IO (RunValue, State) +callClosure info@(Info bbmap gfds _) state@(State { sTempMap = tmap }) cl as = + case findRef tmap cl of + RVClosure clname clvals -> case Map.lookup clname gfds of + Just (GlobFuncDef b _ _) -> do + (rv, state') <- vmRunBB info (state { sArgs = map (findRef tmap) as, sCloVals = clvals }) + (bbmap Map.! b) + return (rv, state' { sArgs = sArgs state, sCloVals = sCloVals state }) + Nothing -> + -- Take 'tail as' to skip the first self-link argument + vmRunBuiltin state clname (map (findRef tmap) (tail as)) + obj -> error $ "VM: Cannot call non-closure object: " ++ show obj + vmRunBuiltin :: State -> Name -> [RunValue] -> IO (RunValue, State) -- vmRunBuiltin _ name args | trace (name ++ " " ++ show args) False = undefined vmRunBuiltin state "print" as = putStrLn (intercalate ", " (map printshow as)) >> return (RVList [], state) |