git @ Cat's Eye Technologies Carriage / 797bf6a
Initial import of files for Carriage distribution. Chris Pressey 2 years ago
12 changed file(s) with 245 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 *.exe
1 *.hi
2 *.o
3 *.js
4 *.jsmod
0 Carriage
1 ========
2
3 This is the long-missing reference distribution for Carriage.
0 This is free and unencumbered software released into the public domain.
1
2 Anyone is free to copy, modify, publish, use, compile, sell, or
3 distribute this software, either in source code form or as a compiled
4 binary, for any purpose, commercial or non-commercial, and by any
5 means.
6
7 In jurisdictions that recognize copyright laws, the author or authors
8 of this software dedicate any and all copyright interest in the
9 software to the public domain. We make this dedication for the benefit
10 of the public at large and to the detriment of our heirs and
11 successors. We intend this dedication to be an overt act of
12 relinquishment in perpetuity of all present and future rights to this
13 software under copyright law.
14
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18 IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
19 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
20 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
21 OTHER DEALINGS IN THE SOFTWARE.
22
23 For more information, please refer to <http://unlicense.org/>
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=carriage
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 >/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 #!/bin/sh
1
2 rm -f src/*.hi src/*.o src/*.jsmod bin/*.exe
3 rm -f src/Language/*/*.hi src/Language/*/*.o src/Language/*/*.jsmod
0 <!DOCTYPE html>
1 <head>
2 <meta charset="utf-8">
3 <title>Carriage interpreter</title>
4 </head>
5 <body>
6
7 <h1>Carriage interpreter</h1>
8
9 <p>(Language.Carriage 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-launcher.js"></script>
15 <script src="carriage.js"></script>
16 <script>
17 launch({
18 container: document.getElementById('installation'),
19 initialOption: "trivial.carriage"
20 });
21 </script>
22 </body>
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><button id="run-button">Run</button></div>
5 <pre id="result"></pre>
6 `;
7
8 function makeSelect(container, labelText, optionsArray, fun) {
9 var label = document.createElement('label');
10 label.innerHTML = labelText;
11 container.appendChild(label);
12 var select = document.createElement("select");
13 for (var i = 0; i < optionsArray.length; i++) {
14 var op = document.createElement("option");
15 op.text = optionsArray[i].filename;
16 op.value = optionsArray[i].contents;
17 select.options.add(op);
18 }
19 select.onchange = function(e) {
20 fun(optionsArray[select.selectedIndex]);
21 };
22 select.selectedIndex = 0;
23 label.appendChild(select);
24 return select;
25 };
26
27 function selectOptionByText(selectElem, text) {
28 var optElem;
29 for (var i = 0; optElem = selectElem.options[i]; i++) {
30 if (optElem.text === text) {
31 selectElem.selectedIndex = i;
32 selectElem.dispatchEvent(new Event('change'));
33 return;
34 }
35 }
36 }
37
38 var controlPanel = document.getElementById('control-panel');
39 var select = makeSelect(controlPanel, "example program:", examplePrograms, function(option) {
40 document.getElementById('prog').value = option.contents;
41 });
42 selectOptionByText(select, config.initialOption);
43 }
0 module Main where
1
2 import Haste.DOM (withElems, getValue, setProp)
3 import Haste.Events (onEvent, MouseEvent(Click))
4
5 import qualified Language.Carriage.Evaluator as Evaluator
6
7
8 main = withElems ["prog", "result", "run-button"] driver
9
10 driver [progElem, resultElem, runButtonElem] =
11 onEvent runButtonElem Click $ \_ -> do
12 Just prog <- getValue progElem
13 setProp resultElem "textContent" $ show $ Evaluator.run prog
0 module Language.Carriage.Evaluator where
1
2 explode = error "BOOM"
3
4 data Elem = Int Integer
5 | Fn ([Elem] -> [Elem])
6 | Sym Char
7 instance Show Elem where
8 show (Int i) = show i
9 show (Fn _) = "<fn>"
10 show (Sym c) = show c
11
12 pop (e:s) = (e, s)
13 push s e = (e:s)
14
15 pick 0 ((Sym _):_) = explode
16 pick 0 (e:_) = e
17 pick n (_:s) = pick (n-1) s
18
19 slice _ 0 _ = []
20 slice p k s = slice' p (reverse s)
21 where
22 slice' 0 s = take (fromIntegral k) s
23 slice' n (_:s) = slice' (n-1) s
24
25 ci " " = id
26 ci "1" = \s -> push s $ Int 1
27 ci "$" = snd . pop
28 ci "#" = \s -> push s $ Int $ fromIntegral $ length s
29 ci "~" = (\s ->
30 let
31 (Int a, s') = pop(s)
32 in
33 push s' $ pick a s')
34 ci "\\" = (\s ->
35 let
36 (a, s') = pop(s)
37 (b, s'') = pop(s')
38 in
39 push (push s'' a) b)
40 ci "+" = (\s ->
41 let
42 (Int a, s') = pop(s)
43 (Int b, s'') = pop(s')
44 in
45 push s'' $ Int (a + b))
46 ci "-" = (\s ->
47 let
48 (Int a, s') = pop(s)
49 (Int b, s'') = pop(s')
50 in
51 push s'' $ Int (b - a))
52 ci "@" = (\s ->
53 let
54 (Int k, s') = pop(s)
55 (Int p, s'') = pop(s')
56 fn = ci $ map (\(Sym c) -> c) $ slice p k s''
57 in
58 push s'' (Fn fn))
59 ci "!" = \s -> let (Fn f, s') = pop(s) in f s'
60 ci [] = id
61 ci [_] = explode
62 ci (sym:rest) = \x -> (ci rest) ((ci [sym]) x)
63
64 di = reverse . map (\x -> Sym x) . filter (\x -> x /= ' ')
65
66 run prog = (ci prog) (di prog)
0 module Main where
1
2 import System.Environment
3 import System.Exit
4 import System.IO
5
6 import qualified Language.Carriage.Evaluator as Evaluator
7
8
9 main = do
10 args <- getArgs
11 case args of
12 ["run", fileName] -> do
13 text <- readFile fileName
14 putStrLn $ show $ Evaluator.run text
15 return ()
16 _ -> do
17 abortWith "Usage: carriage run <carriage-program-text-filename>"
18
19 abortWith msg = do
20 hPutStrLn stderr msg
21 exitWith (ExitFailure 1)
0 #!/bin/sh
1
2 falderal README.md || exit 1