summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-12-13 22:18:43 +0100
committertomsmeding <tom.smeding@gmail.com>2017-12-13 22:18:43 +0100
commit3fca4bf68ff8df1639416f0630452272c647cd00 (patch)
tree6f85fbacbe99611affa5ff6025da1530e40a160a
parent897fb17dd6a045a7056e6d6babbbb24748f698f6 (diff)
Datas
-rw-r--r--compiler.hs9
-rw-r--r--fibo.lisp2
-rw-r--r--vm.hs18
3 files changed, 17 insertions, 12 deletions
diff --git a/compiler.hs b/compiler.hs
index d63f7bf..64b887c 100644
--- a/compiler.hs
+++ b/compiler.hs
@@ -4,10 +4,8 @@ module Compiler(IRProgram, compileProgram) where
import Control.Monad.Except
import Control.Monad.State.Strict
import Data.List
-import Data.Maybe
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
-import Debug.Trace
import AST
import Intermediate
@@ -220,11 +218,16 @@ genTValue (TVString s) nextnext = do
addIns (r, IData i)
setTerm $ IJmp nextnext
return r
+genTValue (TVQuoted v) nextnext = do
+ i <- dataTableAdd v
+ r <- genTemp
+ addIns (r, IData i)
+ setTerm $ IJmp nextnext
+ return r
genTValue (TVDefine name value) nextnext = do
dref <- genTemp
defineAdd name dref
vref <- genTValue value nextnext
- -- traceShowM ("tvdefine_refs", dref, vref, name, value)
addIns (dref, IAssign vref)
return RNone
genTValue (TVLambda args body closure) nextnext = do
diff --git a/fibo.lisp b/fibo.lisp
index 7ce4ea6..3beae63 100644
--- a/fibo.lisp
+++ b/fibo.lisp
@@ -114,7 +114,7 @@
(define for (start end f)
(if (<= start end)
(do (f start) (for (+ start 1) end f))
- 0)) ; TODO: '()
+ '()))
; == main lambda ==
; Params: 3
diff --git a/vm.hs b/vm.hs
index 10c084f..c21e228 100644
--- a/vm.hs
+++ b/vm.hs
@@ -12,11 +12,14 @@ import AST
import Intermediate
-data Info = Info (Map.Map Int BB) (Map.Map Name GlobFuncDef)
+data Info =
+ Info (Map.Map Int BB) -- basic blocks
+ (Map.Map Name GlobFuncDef) -- global functions
+ [Value] -- data table
type TempMap = Map.Map Int RunValue
-data State = State TempMap ([RunValue], [RunValue])
+data State = State TempMap ([RunValue] {- current arguments -}, [RunValue] {- current closure -})
data RunValue = RClosure Name [RunValue] | RValue Value
deriving Show
@@ -25,12 +28,11 @@ kErrorExit :: String
kErrorExit = "VM:exit"
vmRun :: IRProgram -> IO ()
-vmRun (IRProgram bbs gfds []) =
+vmRun (IRProgram bbs gfds datas) =
let bbmap = Map.fromList [(bidOf bb, bb) | bb <- bbs]
- info = Info bbmap gfds
+ info = Info bbmap gfds datas
state = State Map.empty ([], [])
in IO.catchIOError (void $ vmRunBB info state (head bbs)) vmErrorHandler
-vmRun _ = undefined
vmErrorHandler :: IOError -> IO ()
vmErrorHandler e =
@@ -43,11 +45,11 @@ vmRunBB info state (BB _ inss term) = do
vmRunInstr :: Info -> State -> Instruction -> IO State
-- vmRunInstr _ _ ins | traceShow ins False = undefined
-vmRunInstr info@(Info bbmap gfds) state@(State tmap (args, closure)) (dest, instr) = case instr of
+vmRunInstr info@(Info bbmap gfds datas) state@(State tmap (args, closure)) (dest, instr) = case instr of
IAssign ref -> return (assignRef state dest (findRef tmap ref))
IParam i -> return (assignRef state dest (args !! i))
IClosure i -> return (assignRef state dest (closure !! i))
- IData _ -> undefined
+ IData i -> return (assignRef state dest (RValue (datas !! i)))
ICallC cl as -> case findRef tmap cl of
RClosure clname clvals -> case Map.lookup clname gfds of
Just (GlobFuncDef b _ _) ->
@@ -62,7 +64,7 @@ vmRunInstr info@(Info bbmap gfds) state@(State tmap (args, closure)) (dest, inst
IDiscard _ -> return state
vmRunTerm :: Info -> State -> Terminator -> IO (RunValue, State)
-vmRunTerm info@(Info bbmap gfds) state@(State tmap (args, closure)) term = case term of
+vmRunTerm info@(Info bbmap _ _) state@(State tmap _) term = case term of
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)