git @ Cat's Eye Technologies ZOWIE / master
Merge pull request #4 from catseye/implement-in-haskell Implement in Haskell Chris Pressey authored a day ago GitHub committed a day ago
13 changed file(s) with 446 addition(s) and 1 deletion(s). Raw diff Collapse all Expand all
0 *.exe
1 *.hi
2 *.o
3 *.jsmod
4 demo/zowie-hs.js
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) || exit 1
7 else
8 echo "ghc not found, not building $PROG.exe"
9 fi
10
11 if command -v hastec >/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 function launch(config) {
1 config.container.innerHTML = `
2 <textarea id="prog" rows="10" cols="80"></textarea>
3 <div id="control-panel"></div>
4 <div>Input: <input id="prog-input"></input></div>
5 <div>Output: <pre id="prog-output"></pre></div>
6 <div><button id="run-button">Run</button></div>
7 <pre id="result"></pre>
8 `;
9
10 function makeSelect(container, labelText, optionsArray, fun) {
11 var label = document.createElement('label');
12 label.innerHTML = labelText;
13 container.appendChild(label);
14 var select = document.createElement("select");
15 for (var i = 0; i < optionsArray.length; i++) {
16 var op = document.createElement("option");
17 op.text = optionsArray[i].filename;
18 op.value = optionsArray[i].contents;
19 select.options.add(op);
20 }
21 select.onchange = function(e) {
22 fun(optionsArray[select.selectedIndex]);
23 };
24 select.selectedIndex = 0;
25 label.appendChild(select);
26 return select;
27 };
28
29 function selectOptionByText(selectElem, text) {
30 var optElem;
31 for (var i = 0; optElem = selectElem.options[i]; i++) {
32 if (optElem.text === text) {
33 selectElem.selectedIndex = i;
34 selectElem.dispatchEvent(new Event('change'));
35 return;
36 }
37 }
38 }
39
40 var controlPanel = document.getElementById('control-panel');
41 var select = makeSelect(controlPanel, "example program:", examplePrograms, function(option) {
42 document.getElementById('prog').value = option.contents;
43 });
44 selectOptionByText(select, config.initialOption);
45 }
0 <!DOCTYPE html>
1 <head>
2 <meta charset="utf-8">
3 <title>zowie-hs</title>
4 </head>
5 <body>
6
7 <h1>zowie-hs</h1>
8
9 <p>(zowie-hs compiled to .js by <code>hastec</code>, running in HTML5 document)</p>
10
11 <div id="installation"></div>
12
13 <script src="../../../eg/examplePrograms.jsonp.js"></script>
14 <script src="hastec-io-launcher.js"></script>
15 <script src="zowie-hs.js"></script>
16 <script>
17 launch({
18 container: document.getElementById('installation'),
19 initialOption: "fact.zow"
20 });
21 </script>
22 </body>
0 {-# LANGUAGE OverloadedStrings #-}
1
2 module Main where
3
4 import Haste.DOM (withElems, getValue, setProp)
5 import Haste.Events (onEvent, MouseEvent(Click))
6 import Haste.Foreign (ffi)
7
8 import qualified Language.ZOWIE.Parser as Parser
9 import qualified Language.ZOWIE.Machine as Machine
10
11
12 getCh :: IO Char
13 getCh = ffi "(function() {var i=document.getElementById('prog-input'); var s=i.value; i.value=s.substring(1); return s.charCodeAt(0);})"
14
15 putCh :: Char -> IO ()
16 putCh = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent += String.fromCharCode(c);})"
17
18 clearOutput :: IO ()
19 clearOutput = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent = '';})"
20
21 main = withElems ["prog", "result", "run-button"] driver
22
23 driver [progElem, resultElem, runButtonElem] =
24 onEvent runButtonElem Click $ \_ -> do
25 Just text <- getValue progElem
26 clearOutput
27 case Parser.parseZOWIE text of
28 Right prog -> do
29 Machine.loadAndRunWithIO (getCh) (putCh) prog
30 return ()
31 Left error ->
32 setProp resultElem "textContent" $ show error
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)
56
57 loadAndRunWithIO getCh putCh prog = run (initState prog){ getCh=getCh, putCh=putCh }
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 --
12 -- The grammar of a line is
13 --
14 -- Line ::= Comment | "MOV" Operand "," Operand [Comment].
15 -- Operand ::= "R[R" Number "]" | "R" Number | Number.
16 -- Comment ::= ";" anything.
17 --
18
19 zowie = many1 (commentLine <|> instrLine)
20
21 comment = do
22 spaces
23 string ";"
24 many $ satisfy (\x -> x /= '\n')
25
26 commentLine :: Parser (Maybe Instruction)
27 commentLine = do
28 optional comment
29 newline
30 return Nothing
31
32 instrLine :: Parser (Maybe Instruction)
33 instrLine = do
34 spaces
35 string "MOV"
36 dest <- operand
37 spaces
38 string ","
39 src <- operand
40 optional comment
41 newline
42 return $ Just $ Mov dest src
43
44 operand = do
45 spaces
46 r <- (try indirect) <|> (try direct) <|> immediate
47 return r
48
49 indirect = do
50 string "R[R"
51 n <- number
52 string "]"
53 return $ Indirect n
54
55 direct = do
56 string "R"
57 n <- number
58 return $ Direct n
59
60 immediate = do
61 n <- number
62 return $ Immediate n
63
64 -- ..................................................... --
65
66 number = do
67 c <- digit
68 cs <- many digit
69 num <- return (read (c:cs) :: Integer)
70 return num
71
72 spaces = many $ satisfy (\x -> x `elem` [' ', '\t'])
73
74 -- ..................................................... --
75
76 parseZOWIE text =
77 case parse zowie "" (text ++ "\n") of
78 Left err ->
79 Left err
80 Right maybes ->
81 Right (catMaybes maybes)
0 module Language.ZOWIE.Registers where
1
2 import Data.Char (chr, ord)
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 <- getCh state
33 return $ fromIntegral $ ord 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 putCh state $ 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 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 getCh :: IO Char,
24 putCh :: Char -> IO ()
25 }
26
27
28 initState :: [Instruction] -> State
29 initState prog =
30 State{
31 pc=0,
32 mem=Map.empty,
33 prog=prog,
34 saved=Nothing,
35 getCh=getChar,
36 putCh=putChar
37 }
38
39 readMem mem addr = Map.findWithDefault 0 addr mem
40 writeMem mem addr value = Map.insert addr value mem
41
42 beginTransaction :: State -> State
43 beginTransaction state@State{} =
44 state{ saved=(Just state) }
45
46 rollback :: State -> State
47 rollback state@State{ pc=pc, saved=(Just previous) } =
48 previous{ pc=pc }
49
50 commit :: State -> State
51 commit state@State{ saved=(Just previous) } =
52 state{ saved=(saved previous) }
53
54 commitAndRepeat :: State -> State
55 commitAndRepeat state@State{ saved=(Just previous) } =
56 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 Machine.loadAndRun prog
20 return ()
21 _ -> do
22 abortWith "Usage: zowie-hs (parse|run) <zowie-program-filename>"
23
24 loadSource fileName = do
25 text <- readFile fileName
26 case Parser.parseZOWIE text of
27 Right prog -> do
28 return prog
29 Left error ->
30 abortWith $ show error
31
32 abortWith msg = do
33 hPutStrLn stderr msg
34 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-hs ]; then
13 APPLIANCES="$APPLIANCES tests/appliances/zowie-hs.md"
14 fi
1215
1316 if [ "x$APPLIANCES" = "x" ]; then
14 echo "No suitable Python versions or RPython-compiled executables found."
17 echo "No suitable Python versions or ZOWIE implementations found."
1518 exit 1
1619 fi
1720
0 -> Functionality "Interpret ZOWIE Program" is implemented by
1 -> shell command
2 -> "./impl/zowie-hs/bin/zowie-hs run %(test-body-file)"