module Machine
    where

import Prelude hiding (EQ, LT, GT)
import Maybe

------------------------------------------------------
-- MA Machine:


-- Zustand
type Memory = [Int]
--                 BZ Stack  Speicher
data MAState = MA Int [Int]   Memory
	     deriving (Eq,Show)

startMA :: MAState
startMA = MA 0 [] []

-- Startbelegung des Speichers vorgeben
initMA :: [Int] -> MAState 
initMA ini = MA 0 [] ini

-- Code 
type MAProg = [MACode]

data MACode = ADD | SUB | MULT | DIV -- Arithm. Op.
	    | EQ | NEQ | LT | GT     -- Rel. Op.
	    | AND | OR | NOT         -- Bool. Op.
	    | LIT Int                -- Push Literal 
	    | LOAD Int | STORE Int   -- Mem. Op.
	    | JMP Int | JPFALSE Int  -- Ctrl. Op.
	    | NOOP
	      deriving (Eq,Show)

-- Programme  für MA ausführen:
runMA :: MAProg -> MAState
runMA prog = runStateMA prog startMA
traceMA :: MAProg -> [MAState]
traceMA prog = traceStateMA prog startMA

-- Funktion MA_I im Script
runStateMA :: MAProg -> MAState -> MAState
runStateMA prog s
    = case oneStepMA prog s of 
             Nothing -> s
	     Just s' -> runStateMA prog s'

traceStateMA :: MAProg -> MAState -> [MAState]
traceStateMA prog s@(MA bz _ _) 
    | bz < 0 || bz >= (length prog) = [s]
    | otherwise = s:traceStateMA prog (execMA (prog!!bz) s)

oneStepMA :: MAProg -> MAState -> Maybe MAState
oneStepMA prog s@(MA bz _ _)
    | bz < 0 || bz >= (length prog) = Nothing
    | otherwise = Just $ execMA (prog!!bz) s

------------------------------------------------------
-- Befehlssemantik MA (Funktion MA_C im Script)
execMA :: MACode -> MAState -> MAState
execMA ADD  (MA bz  (a:b:ds) mem) = MA (bz+1) ( (b+a):ds ) mem 
execMA SUB  (MA bz  (a:b:ds) mem) = MA (bz+1) ( (b-a):ds ) mem 
execMA MULT (MA bz  (a:b:ds) mem) = MA (bz+1) ((b*a):ds ) mem 
execMA DIV  (MA bz  (a:b:ds) mem) = MA (bz+1) ( (b `div` a):ds ) mem 
execMA EQ   (MA bz  (a:b:ds) mem) = MA (bz+1) ( (fromBool (b==a)):ds ) mem 
execMA NEQ  (MA bz  (a:b:ds) mem) = MA (bz+1) ( (fromBool (b/=a)):ds ) mem 
execMA LT   (MA bz  (a:b:ds) mem) = MA (bz+1) ( (fromBool (b<a)):ds ) mem 
execMA GT   (MA bz  (a:b:ds) mem) = MA (bz+1) ( (fromBool (b>a)):ds ) mem 
execMA AND  (MA bz  (a:b:ds) mem) = MA (bz+1) ( (sg b * sg a):ds ) mem 
execMA OR   (MA bz  (a:b:ds) mem) = MA (bz+1) ( (sg b + sg a):ds ) mem 
execMA NOT  (MA bz    (a:ds) mem) = MA (bz+1) ( (fromBool (a==0)):ds ) mem 
execMA (LIT n)   (MA bz ds mem)  = MA (bz+1)  (n:ds) mem
execMA (LOAD n)  (MA bz ds mem)
    | n >= 0 && n < lhs = MA (bz+1) ((mem!!n):ds) mem
-- courtesy of M.H., was "n > lhs"
    | n >= lhs          = MA (bz+1)    (0:ds)     mem
    | otherwise         = error "LOAD: ungueltige Adresse"
    where lhs = length mem
execMA (STORE n) (MA bz (a:ds) mem)= MA (bz+1) ds mem'
    where mem' | n >= 0 && n < lhs  = (take n mem) ++ a : (drop (n+1) mem)
               | n >= lhs           = mem ++ exths
               | otherwise          = error "STORE: negative Adresse"
          lhs   = length mem
          exths = replicate (n-lhs) 0 ++ [a]
execMA (JMP n) (MA _  ds mem) = MA n  ds mem
execMA (JPFALSE n) (MA bz  (a:ds) mem) = MA bz' ds mem  
    where bz' = if a == 0 then n else bz + 1
execMA NOOP (MA bz ds mem) = MA (bz+1) ds mem
execMA op st = error $ 
		"Operation " ++ show op ++ "\nZustand " ++ show st

toBool :: Int -> Bool
toBool n = n /= 0

fromBool :: Bool -> Int
fromBool False = 0
fromBool True  = 1

sg :: Int -> Int
sg n | n == 0 = 0
     | n > 0  = 1
     | n < 0  = -1

-------------------------------------------------------

-- Programmfragment:
-- while x!=y do 
--    if x < y 
--        then y := y - x
--        else x := x - y
ggtprog :: MAProg
ggtprog = [ LOAD 1
	   , LOAD 2
	   , NEQ
	   , JPFALSE 18
	   , LOAD 1
	   , LOAD 2
	   , LT
	   , JPFALSE 13
	   , LOAD 2
	   , LOAD 1
	   , SUB
	   , STORE 2
	   , JMP 17
	   , LOAD 1
	   , LOAD 2
	   , SUB
	   , STORE 1
	   , JMP 0
	   , NOOP
	  ]