git @ Cat's Eye Technologies ZOWIE / 6e73f17
Consistently name the Haskell implementation, zowie-hs. Chris Pressey 1 year, 14 days ago
18 changed file(s) with 339 addition(s) and 339 deletion(s). Raw diff Collapse all Expand all
+0
-5
impl/ZOWIE.hs/.gitignore less more
0 *.exe
1 *.hi
2 *.o
3 *.js
4 *.jsmod
+0
-18
impl/ZOWIE.hs/bin/zowie less more
0 #!/bin/sh
1
2 THIS=`realpath $0`
3 DIR=`dirname $THIS`
4 NAME=`basename $THIS`
5 SRC=$DIR/../src
6 if [ "x$FORCE_HUGS" != "x" ] ; then
7 exec runhugs -i$SRC $SRC/Main.hs $*
8 elif [ -x $DIR/$NAME.exe ] ; then
9 exec $DIR/$NAME.exe $*
10 elif command -v runhaskell 2>&1 >/dev/null ; then
11 exec runhaskell -i$SRC $SRC/Main.hs $*
12 elif command -v runhugs 2>&1 >/dev/null ; then
13 exec runhugs -i$SRC $SRC/Main.hs $*
14 else
15 echo "Cannot run $NAME; neither $NAME.exe, nor runhaskell, nor runhugs found."
16 exit 1
17 fi
+0
-17
impl/ZOWIE.hs/build.sh less more
0 #!/bin/sh
1
2 PROG=zowie
3
4 if command -v ghc >/dev/null 2>&1; then
5 echo "building $PROG.exe with ghc"
6 (cd src && ghc --make Main.hs -o ../bin/$PROG.exe)
7 else
8 echo "ghc not found, not building $PROG.exe"
9 fi
10
11 if command -v hastec-not-yet >/dev/null 2>&1; then
12 echo "building $PROG.js with hastec"
13 (cd src && hastec --make HasteMain.hs -o ../demo/$PROG.js) || exit 1
14 else
15 echo "hastec not found, not building $PROG.js"
16 fi
+0
-56
impl/ZOWIE.hs/src/Language/ZOWIE/Machine.hs less more
0 module Language.ZOWIE.Machine where
1
2 import Language.ZOWIE.State
3 import Language.ZOWIE.Registers (readAddr, writeAddr)
4
5
6 getValue :: State -> Reference -> IO Value
7 getValue _ (Immediate v) =
8 return v
9 getValue state (Direct addr) =
10 readAddr state addr
11 getValue state (Indirect addr) = do
12 addr' <- readAddr state addr
13 val <- readAddr state addr'
14 return val
15
16 setValue :: State -> Reference -> Value -> IO State
17 setValue _ (Immediate _) _ =
18 error "Cannot set the value of an immediate reference"
19 setValue state (Direct addr) value =
20 writeAddr state addr value
21 setValue state (Indirect addr) value = do
22 addr' <- readAddr state addr
23 state' <- writeAddr state addr' value
24 return state'
25
26 applyInstr :: State -> Instruction -> IO State
27 applyInstr state (Mov dest src) = do
28 value <- getValue state src
29 state' <- setValue state dest value
30 return state'
31
32 nth :: [a] -> Integer -> Maybe a
33 nth [] _ = Nothing
34 nth (x:xs) 0 = Just x
35 nth (x:xs) n = nth xs (n-1)
36
37 step :: State -> IO (Maybe State)
38 step state =
39 case nth (prog state) (pc state) of
40 Just instr -> do
41 state' <- applyInstr state instr
42 return $ Just state'{ pc=(pc state')+1 }
43 Nothing ->
44 return Nothing
45
46 run :: State -> IO State
47 run state = do
48 result <- step state
49 case result of
50 Just state' ->
51 run state'
52 Nothing ->
53 return state
54
55 loadAndRun prog = run (initState prog)
+0
-87
impl/ZOWIE.hs/src/Language/ZOWIE/Parser.hs less more
0 module Language.ZOWIE.Parser where
1
2 import Data.Maybe (catMaybes)
3 import Text.ParserCombinators.Parsec
4 (
5 many, many1, string, satisfy, Parser, (<|>), digit, newline, optional, try, parse
6 )
7
8 import Language.ZOWIE.State
9
10
11 splitLines :: String -> String -> [String]
12 splitLines [] line = [reverse line]
13 splitLines ('\n':rest) line = [reverse line] ++ (splitLines rest [])
14 splitLines (char:rest) line = splitLines rest (char:line)
15
16 --
17 -- The grammar of a line is
18 --
19 -- Line ::= Comment | "MOV" Operand "," Operand [Comment].
20 -- Operand ::= "R[R" Number "]" | "R" Number | Number.
21 -- Comment ::= ";" anything.
22 --
23
24 zowie = many1 (commentLine <|> instrLine)
25
26 comment = do
27 spaces
28 string ";"
29 many $ satisfy (\x -> x /= '\n')
30
31 commentLine :: Parser (Maybe Instruction)
32 commentLine = do
33 optional comment
34 newline
35 return Nothing
36
37 instrLine :: Parser (Maybe Instruction)
38 instrLine = do
39 spaces
40 string "MOV"
41 dest <- operand
42 spaces
43 string ","
44 src <- operand
45 optional comment
46 newline
47 return $ Just $ Mov dest src
48
49 operand = do
50 spaces
51 r <- (try indirect) <|> (try direct) <|> immediate
52 return r
53
54 indirect = do
55 string "R[R"
56 n <- number
57 string "]"
58 return $ Indirect n
59
60 direct = do
61 string "R"
62 n <- number
63 return $ Direct n
64
65 immediate = do
66 n <- number
67 return $ Immediate n
68
69 -- ..................................................... --
70
71 number = do
72 c <- digit
73 cs <- many digit
74 num <- return (read (c:cs) :: Integer)
75 return num
76
77 spaces = many $ satisfy (\x -> x `elem` [' ', '\t'])
78
79 -- ..................................................... --
80
81 parseZOWIE text =
82 case parse zowie "" (text ++ "\n") of
83 Left err ->
84 Left err
85 Right maybes ->
86 Right (catMaybes maybes)
+0
-65
impl/ZOWIE.hs/src/Language/ZOWIE/Registers.hs less more
0 module Language.ZOWIE.Registers where
1
2 import Data.Char (chr)
3
4 import Language.ZOWIE.State
5
6
7 data Register = TtyRegister
8 | BeginTransactionRegister
9 | CommitRegister
10 | CommitAndRepeatRegister
11 | AdditionRegister
12 | SubtractionRegister
13 | MultiplicationRegister
14 | NegationRegister
15 | RegularRegister Addr
16
17
18 mapRegister 0 = TtyRegister
19 mapRegister 1 = BeginTransactionRegister
20 mapRegister 2 = CommitRegister
21 mapRegister 3 = CommitAndRepeatRegister
22 mapRegister 4 = AdditionRegister
23 mapRegister 5 = SubtractionRegister
24 mapRegister 6 = MultiplicationRegister
25 mapRegister 7 = NegationRegister
26 mapRegister x = RegularRegister x
27
28 readAddr :: State -> Addr -> IO Value
29 readAddr state@State{ mem=mem } addr =
30 case mapRegister addr of
31 TtyRegister -> do
32 i <- readLn
33 return i
34 BeginTransactionRegister -> return 1
35 CommitRegister -> return 2
36 CommitAndRepeatRegister -> return 3
37 AdditionRegister -> return 4
38 SubtractionRegister -> return 5
39 MultiplicationRegister -> return 6
40 NegationRegister -> return 7
41 RegularRegister x -> return (readMem mem x)
42
43 writeAddr :: State -> Addr -> Value -> IO State
44 writeAddr state@State{ mem=mem } addr payload =
45 case mapRegister addr of
46 TtyRegister -> do
47 putChar $ chr $ fromIntegral payload
48 return state
49 BeginTransactionRegister ->
50 return $ beginTransaction state
51 CommitRegister ->
52 return $ if payload > 0 then commit state else rollback state
53 CommitAndRepeatRegister ->
54 return $ if payload > 0 then commitAndRepeat state else commit state
55 AdditionRegister ->
56 return state{ mem=(writeMem mem 8 ((readMem mem 8) + payload)) }
57 SubtractionRegister ->
58 return state{ mem=(writeMem mem 8 ((readMem mem 8) - payload)) }
59 MultiplicationRegister ->
60 return state{ mem=(writeMem mem 8 ((readMem mem 8) * payload)) }
61 NegationRegister ->
62 return state{ mem=(writeMem mem 8 (if payload == 0 then 1 else 0)) }
63 RegularRegister x ->
64 return state{ mem=(writeMem mem x payload) }
+0
-53
impl/ZOWIE.hs/src/Language/ZOWIE/State.hs less more
0 module Language.ZOWIE.State where
1
2 import qualified Data.Map.Strict as Map
3
4
5 type Addr = Integer
6 type Value = Integer
7
8 type Memory = Map.Map Addr Value
9
10 data Reference = Immediate Value
11 | Direct Addr
12 | Indirect Addr
13 deriving (Show, Ord, Eq)
14
15 data Instruction = Mov Reference Reference
16 deriving (Show, Ord, Eq)
17
18 data State = State {
19 pc :: Addr,
20 mem :: Memory,
21 prog :: [Instruction],
22 saved :: Maybe State
23 } deriving (Show, Ord, Eq)
24
25
26 initState :: [Instruction] -> State
27 initState prog =
28 State{
29 pc=0,
30 mem=Map.empty,
31 prog=prog,
32 saved=Nothing
33 }
34
35 readMem mem addr = Map.findWithDefault 0 addr mem
36 writeMem mem addr value = Map.insert addr value mem
37
38 beginTransaction :: State -> State
39 beginTransaction state@State{} =
40 state{ saved=(Just state) }
41
42 rollback :: State -> State
43 rollback state@State{ pc=pc, saved=(Just previous) } =
44 previous{ pc=pc }
45
46 commit :: State -> State
47 commit state@State{ saved=(Just previous) } =
48 state{ saved=(saved previous) }
49
50 commitAndRepeat :: State -> State
51 commitAndRepeat state@State{ saved=(Just previous) } =
52 state{ saved=(saved previous), pc=((pc previous) - 1) }
+0
-36
impl/ZOWIE.hs/src/Main.hs less more
0 module Main where
1
2 import System.Environment
3 import System.Exit
4 import System.IO
5
6 import qualified Language.ZOWIE.Parser as Parser
7 import qualified Language.ZOWIE.Machine as Machine
8
9
10 main = do
11 args <- getArgs
12 case args of
13 ["parse", fileName] -> do
14 prog <- loadSource fileName
15 putStrLn $ show $ prog
16 return ()
17 ["run", fileName] -> do
18 prog <- loadSource fileName
19 result <- Machine.loadAndRun prog
20 -- putStrLn $ show $ result
21 return ()
22 _ -> do
23 abortWith "Usage: zowie (parse|run) <zowie-program-filename>"
24
25 loadSource fileName = do
26 text <- readFile fileName
27 case Parser.parseZOWIE text of
28 Right prog -> do
29 return prog
30 Left error ->
31 abortWith $ show error
32
33 abortWith msg = do
34 hPutStrLn stderr msg
35 exitWith (ExitFailure 1)
0 *.exe
1 *.hi
2 *.o
3 *.js
4 *.jsmod
0 #!/bin/sh
1
2 THIS=`realpath $0`
3 DIR=`dirname $THIS`
4 NAME=`basename $THIS`
5 SRC=$DIR/../src
6 if [ "x$FORCE_HUGS" != "x" ] ; then
7 exec runhugs -i$SRC $SRC/Main.hs $*
8 elif [ -x $DIR/$NAME.exe ] ; then
9 exec $DIR/$NAME.exe $*
10 elif command -v runhaskell 2>&1 >/dev/null ; then
11 exec runhaskell -i$SRC $SRC/Main.hs $*
12 elif command -v runhugs 2>&1 >/dev/null ; then
13 exec runhugs -i$SRC $SRC/Main.hs $*
14 else
15 echo "Cannot run $NAME; neither $NAME.exe, nor runhaskell, nor runhugs found."
16 exit 1
17 fi
0 #!/bin/sh
1
2 PROG=zowie-hs
3
4 if command -v ghc >/dev/null 2>&1; then
5 echo "building $PROG.exe with ghc"
6 (cd src && ghc --make Main.hs -o ../bin/$PROG.exe)
7 else
8 echo "ghc not found, not building $PROG.exe"
9 fi
10
11 if command -v hastec-not-yet >/dev/null 2>&1; then
12 echo "building $PROG.js with hastec"
13 (cd src && hastec --make HasteMain.hs -o ../demo/$PROG.js) || exit 1
14 else
15 echo "hastec not found, not building $PROG.js"
16 fi
0 module Language.ZOWIE.Machine where
1
2 import Language.ZOWIE.State
3 import Language.ZOWIE.Registers (readAddr, writeAddr)
4
5
6 getValue :: State -> Reference -> IO Value
7 getValue _ (Immediate v) =
8 return v
9 getValue state (Direct addr) =
10 readAddr state addr
11 getValue state (Indirect addr) = do
12 addr' <- readAddr state addr
13 val <- readAddr state addr'
14 return val
15
16 setValue :: State -> Reference -> Value -> IO State
17 setValue _ (Immediate _) _ =
18 error "Cannot set the value of an immediate reference"
19 setValue state (Direct addr) value =
20 writeAddr state addr value
21 setValue state (Indirect addr) value = do
22 addr' <- readAddr state addr
23 state' <- writeAddr state addr' value
24 return state'
25
26 applyInstr :: State -> Instruction -> IO State
27 applyInstr state (Mov dest src) = do
28 value <- getValue state src
29 state' <- setValue state dest value
30 return state'
31
32 nth :: [a] -> Integer -> Maybe a
33 nth [] _ = Nothing
34 nth (x:xs) 0 = Just x
35 nth (x:xs) n = nth xs (n-1)
36
37 step :: State -> IO (Maybe State)
38 step state =
39 case nth (prog state) (pc state) of
40 Just instr -> do
41 state' <- applyInstr state instr
42 return $ Just state'{ pc=(pc state')+1 }
43 Nothing ->
44 return Nothing
45
46 run :: State -> IO State
47 run state = do
48 result <- step state
49 case result of
50 Just state' ->
51 run state'
52 Nothing ->
53 return state
54
55 loadAndRun prog = run (initState prog)
0 module Language.ZOWIE.Parser where
1
2 import Data.Maybe (catMaybes)
3 import Text.ParserCombinators.Parsec
4 (
5 many, many1, string, satisfy, Parser, (<|>), digit, newline, optional, try, parse
6 )
7
8 import Language.ZOWIE.State
9
10
11 splitLines :: String -> String -> [String]
12 splitLines [] line = [reverse line]
13 splitLines ('\n':rest) line = [reverse line] ++ (splitLines rest [])
14 splitLines (char:rest) line = splitLines rest (char:line)
15
16 --
17 -- The grammar of a line is
18 --
19 -- Line ::= Comment | "MOV" Operand "," Operand [Comment].
20 -- Operand ::= "R[R" Number "]" | "R" Number | Number.
21 -- Comment ::= ";" anything.
22 --
23
24 zowie = many1 (commentLine <|> instrLine)
25
26 comment = do
27 spaces
28 string ";"
29 many $ satisfy (\x -> x /= '\n')
30
31 commentLine :: Parser (Maybe Instruction)
32 commentLine = do
33 optional comment
34 newline
35 return Nothing
36
37 instrLine :: Parser (Maybe Instruction)
38 instrLine = do
39 spaces
40 string "MOV"
41 dest <- operand
42 spaces
43 string ","
44 src <- operand
45 optional comment
46 newline
47 return $ Just $ Mov dest src
48
49 operand = do
50 spaces
51 r <- (try indirect) <|> (try direct) <|> immediate
52 return r
53
54 indirect = do
55 string "R[R"
56 n <- number
57 string "]"
58 return $ Indirect n
59
60 direct = do
61 string "R"
62 n <- number
63 return $ Direct n
64
65 immediate = do
66 n <- number
67 return $ Immediate n
68
69 -- ..................................................... --
70
71 number = do
72 c <- digit
73 cs <- many digit
74 num <- return (read (c:cs) :: Integer)
75 return num
76
77 spaces = many $ satisfy (\x -> x `elem` [' ', '\t'])
78
79 -- ..................................................... --
80
81 parseZOWIE text =
82 case parse zowie "" (text ++ "\n") of
83 Left err ->
84 Left err
85 Right maybes ->
86 Right (catMaybes maybes)
0 module Language.ZOWIE.Registers where
1
2 import Data.Char (chr)
3
4 import Language.ZOWIE.State
5
6
7 data Register = TtyRegister
8 | BeginTransactionRegister
9 | CommitRegister
10 | CommitAndRepeatRegister
11 | AdditionRegister
12 | SubtractionRegister
13 | MultiplicationRegister
14 | NegationRegister
15 | RegularRegister Addr
16
17
18 mapRegister 0 = TtyRegister
19 mapRegister 1 = BeginTransactionRegister
20 mapRegister 2 = CommitRegister
21 mapRegister 3 = CommitAndRepeatRegister
22 mapRegister 4 = AdditionRegister
23 mapRegister 5 = SubtractionRegister
24 mapRegister 6 = MultiplicationRegister
25 mapRegister 7 = NegationRegister
26 mapRegister x = RegularRegister x
27
28 readAddr :: State -> Addr -> IO Value
29 readAddr state@State{ mem=mem } addr =
30 case mapRegister addr of
31 TtyRegister -> do
32 i <- readLn
33 return i
34 BeginTransactionRegister -> return 1
35 CommitRegister -> return 2
36 CommitAndRepeatRegister -> return 3
37 AdditionRegister -> return 4
38 SubtractionRegister -> return 5
39 MultiplicationRegister -> return 6
40 NegationRegister -> return 7
41 RegularRegister x -> return (readMem mem x)
42
43 writeAddr :: State -> Addr -> Value -> IO State
44 writeAddr state@State{ mem=mem } addr payload =
45 case mapRegister addr of
46 TtyRegister -> do
47 putChar $ chr $ fromIntegral payload
48 return state
49 BeginTransactionRegister ->
50 return $ beginTransaction state
51 CommitRegister ->
52 return $ if payload > 0 then commit state else rollback state
53 CommitAndRepeatRegister ->
54 return $ if payload > 0 then commitAndRepeat state else commit state
55 AdditionRegister ->
56 return state{ mem=(writeMem mem 8 ((readMem mem 8) + payload)) }
57 SubtractionRegister ->
58 return state{ mem=(writeMem mem 8 ((readMem mem 8) - payload)) }
59 MultiplicationRegister ->
60 return state{ mem=(writeMem mem 8 ((readMem mem 8) * payload)) }
61 NegationRegister ->
62 return state{ mem=(writeMem mem 8 (if payload == 0 then 1 else 0)) }
63 RegularRegister x ->
64 return state{ mem=(writeMem mem x payload) }
0 module Language.ZOWIE.State where
1
2 import qualified Data.Map.Strict as Map
3
4
5 type Addr = Integer
6 type Value = Integer
7
8 type Memory = Map.Map Addr Value
9
10 data Reference = Immediate Value
11 | Direct Addr
12 | Indirect Addr
13 deriving (Show, Ord, Eq)
14
15 data Instruction = Mov Reference Reference
16 deriving (Show, Ord, Eq)
17
18 data State = State {
19 pc :: Addr,
20 mem :: Memory,
21 prog :: [Instruction],
22 saved :: Maybe State
23 } deriving (Show, Ord, Eq)
24
25
26 initState :: [Instruction] -> State
27 initState prog =
28 State{
29 pc=0,
30 mem=Map.empty,
31 prog=prog,
32 saved=Nothing
33 }
34
35 readMem mem addr = Map.findWithDefault 0 addr mem
36 writeMem mem addr value = Map.insert addr value mem
37
38 beginTransaction :: State -> State
39 beginTransaction state@State{} =
40 state{ saved=(Just state) }
41
42 rollback :: State -> State
43 rollback state@State{ pc=pc, saved=(Just previous) } =
44 previous{ pc=pc }
45
46 commit :: State -> State
47 commit state@State{ saved=(Just previous) } =
48 state{ saved=(saved previous) }
49
50 commitAndRepeat :: State -> State
51 commitAndRepeat state@State{ saved=(Just previous) } =
52 state{ saved=(saved previous), pc=((pc previous) - 1) }
0 module Main where
1
2 import System.Environment
3 import System.Exit
4 import System.IO
5
6 import qualified Language.ZOWIE.Parser as Parser
7 import qualified Language.ZOWIE.Machine as Machine
8
9
10 main = do
11 args <- getArgs
12 case args of
13 ["parse", fileName] -> do
14 prog <- loadSource fileName
15 putStrLn $ show $ prog
16 return ()
17 ["run", fileName] -> do
18 prog <- loadSource fileName
19 result <- Machine.loadAndRun prog
20 -- putStrLn $ show $ result
21 return ()
22 _ -> do
23 abortWith "Usage: zowie (parse|run) <zowie-program-filename>"
24
25 loadSource fileName = do
26 text <- readFile fileName
27 case Parser.parseZOWIE text of
28 Right prog -> do
29 return prog
30 Left error ->
31 abortWith $ show error
32
33 abortWith msg = do
34 hPutStrLn stderr msg
35 exitWith (ExitFailure 1)
99 if [ -x bin/zowie-c ]; then
1010 APPLIANCES="$APPLIANCES tests/appliances/zowie-c.md"
1111 fi
12 if [ -x impl/ZOWIE.hs/bin/zowie ]; then
12 if [ -x impl/zowie-hs/bin/zowie-hs ]; then
1313 APPLIANCES="$APPLIANCES tests/appliances/zowie-hs.md"
1414 fi
1515
00 -> Functionality "Interpret ZOWIE Program" is implemented by
11 -> shell command
2 -> "./impl/ZOWIE.hs/bin/zowie run %(test-body-file)"
2 -> "./impl/zowie-hs/bin/zowie-hs run %(test-body-file)"