git @ Cat's Eye Technologies ZOWIE / compile-with-hastec
Dependency injection for getCh, putCh, so IO can work in browser. Chris Pressey 2 months ago
8 changed file(s) with 77 addition(s) and 13 deletion(s). Raw diff Collapse all Expand all
00 *.exe
11 *.hi
22 *.o
3 *.js
43 *.jsmod
54 demo/zowie-hs.js
33
44 if command -v ghc >/dev/null 2>&1; then
55 echo "building $PROG.exe with ghc"
6 (cd src && ghc --make Main.hs -o ../bin/$PROG.exe)
6 (cd src && ghc --make Main.hs -o ../bin/$PROG.exe) || exit 1
77 else
88 echo "ghc not found, not building $PROG.exe"
99 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 }
1111 <div id="installation"></div>
1212
1313 <script src="../../../eg/index.js"></script>
14 <script src="hastec-launcher.js"></script>
14 <script src="hastec-io-launcher.js"></script>
1515 <script src="zowie-hs.js"></script>
1616 <script>
1717 launch({
0 {-# LANGUAGE OverloadedStrings #-}
1
02 module Main where
13
24 import Haste.DOM (withElems, getValue, setProp)
35 import Haste.Events (onEvent, MouseEvent(Click))
6 import Haste.Foreign (ffi)
47
58 import qualified Language.ZOWIE.Parser as Parser
69 import qualified Language.ZOWIE.Machine as Machine
710
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 = '';})"
820
921 main = withElems ["prog", "result", "run-button"] driver
1022
1123 driver [progElem, resultElem, runButtonElem] =
1224 onEvent runButtonElem Click $ \_ -> do
1325 Just text <- getValue progElem
26 clearOutput
1427 case Parser.parseZOWIE text of
1528 Right prog -> do
16 result <- Machine.loadAndRun prog
17 setProp resultElem "textContent" $ show result
29 Machine.loadAndRunWithIO (getCh) (putCh) prog
30 setProp resultElem "textContent" $ "ok"
1831 Left error ->
19 setProp resultElem "textContent" $ show error
32 setProp resultElem "textContent" $ show error
5353 return state
5454
5555 loadAndRun prog = run (initState prog)
56
57 loadAndRunWithIO getCh putCh prog = run (initState prog){ getCh=getCh, putCh=putCh }
00 module Language.ZOWIE.Registers where
11
2 import Data.Char (chr)
2 import Data.Char (chr, ord)
33
44 import Language.ZOWIE.State
55
2929 readAddr state@State{ mem=mem } addr =
3030 case mapRegister addr of
3131 TtyRegister -> do
32 i <- readLn
33 return i
32 i <- getCh state
33 return $ fromIntegral $ ord i
3434 BeginTransactionRegister -> return 1
3535 CommitRegister -> return 2
3636 CommitAndRepeatRegister -> return 3
4444 writeAddr state@State{ mem=mem } addr payload =
4545 case mapRegister addr of
4646 TtyRegister -> do
47 putChar $ chr $ fromIntegral payload
47 putCh state $ chr $ fromIntegral payload
4848 return state
4949 BeginTransactionRegister ->
5050 return $ beginTransaction state
1919 pc :: Addr,
2020 mem :: Memory,
2121 prog :: [Instruction],
22 saved :: Maybe State
23 } deriving (Show, Ord, Eq)
22 saved :: Maybe State,
23 getCh :: IO Char,
24 putCh :: Char -> IO ()
25 }
2426
2527
2628 initState :: [Instruction] -> State
2931 pc=0,
3032 mem=Map.empty,
3133 prog=prog,
32 saved=Nothing
34 saved=Nothing,
35 getCh=getChar,
36 putCh=putChar
3337 }
3438
3539 readMem mem addr = Map.findWithDefault 0 addr mem