Commit 7a5f728cf5d0add6d369a00ffb2787d6e0b93983 - Equipage

+5

-0

.gitignore less more

0	0	*.pyc
	1	*.exe
	2	*.hi
	3	*.o
	4	*.js
	5	*.jsmod

+19

-0

HISTORY.md less more

	0	History of Equipage
	1	===================
	2
	3	Version 1.0-2019.0926
	4	---------------------
	5
	6	Added implementation in PureScript by Xavier Pinho to the repository.
	7	(Thanks Xavier!)
	8
	9	Renamed the modules to conform with the (putative) Haskell module
	10	hierarchy naming convention.
	11
	12	Added build script, Haskell-implementation-agnostic runner script,
	13	and means for compiling to Javascript with the Haste compiler.
	14
	15	Version 1.0 (May 14 2018)
	16	-----------
	17
	18	Initial public release.

+2

-4

README.md less more

81	81	-> Tests for functionality "Interpret Equipage Program"
82	82
83	83	-> Functionality "Interpret Equipage Program" is implemented by
84		-> shell command
85		-> "(cd src && runhaskell Main.hs %(test-body-file))"
	84	-> shell command "bin/equipage %(test-body-file)"
86	85
87	86	-> Functionality "Interpret Equipage Program" is implemented by
88	87	-> shell command

464	463	-> Tests for functionality "Interpret EquipageQ Program"
465	464
466	465	-> Functionality "Interpret EquipageQ Program" is implemented by
467		-> shell command
468		-> "(cd src && runhaskell Main.hs -Q %(test-body-file))"
	466	-> shell command "bin/equipage -Q %(test-body-file)"
469	467
470	468	-> Functionality "Interpret EquipageQ Program" is implemented by
471	469	-> shell command

+18

-0

bin/equipage 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

+17

-0

build.sh less more

	0	#!/bin/sh
	1
	2	PROG=equipage
	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

+23

-0

demo/equipage.html less more

	0	<!DOCTYPE html>
	1	<head>
	2	<meta charset="utf-8">
	3	<title>Equipage interpreter</title>
	4	</head>
	5	<body>
	6
	7	<h1>Equipage interpreter</h1>
	8
	9	<p>(Language.Equipage 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="equipage.js"></script>
	16	<script>
	17	launch({
	18	container: document.getElementById('installation'),
	19	initialOption: "simple-stack.equipage"
	20	});
	21	</script>
	22	</body>

+44

-0

demo/hastec-launcher.js less more

	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	}

+14

-0

eg/examplePrograms.jsonp.js less more

	0	examplePrograms = [
	1	{
	2	"contents": "1~%1-1-1-~;\n.!.!.!.!.!.!.!.!.!.!\n\n$11-1-~;\n.!.!.!.!.!.!.!\n\n1$\n.!\n\n11+11-11+1\n.!.!.!.!.!.!.!.!.!\n!\n\n11-1-~;\n.!.!.!.!.!.!\n!\n",
	3	"filename": "pop-all-positives.equipage"
	4	},
	5	{
	6	"contents": "1!\n1!1!+!\n1!1!+!1!+!\n",
	7	"filename": "simple-stack.equipage"
	8	},
	9	{
	10	"contents": "1!\n",
	11	"filename": "trivial1.equipage"
	12	}
	13	];

+0

-42

~~src/Equipage.hs~~ less more

0		module Equipage where
1
2		data Elem = Int Integer
3		\| Fn ([Elem] -> [Elem])
4
5		instance Show Elem where
6		show (Int i) = show i
7		show (Fn _) = "<fn>"
8
9		apply (Fn f:s) = f s
10		compose (Fn f1:Fn f2:s) = ((Fn (f1 . f2)):s)
11
12		pop (e:s) = s
13		swap (e1:e2:s) = (e2:e1:s)
14
15		add ((Int a):(Int b):s) = ((Int (a + b)):s)
16		sub ((Int a):(Int b):s) = ((Int (b - a)):s)
17
18		sign (Int a:s) = (Int (if a > 0 then 1 else if a < 0 then -1 else 0):s)
19		pick (Int a:s) = ((if a > 0 then pick' a s else if a < 0 then pick' (0-a) (reverse s) else (Int 0)):s)
20		pick' 1 (s:t) = s
21		pick' n (s:t) = pick' (n-1) t
22
23		push e s = (e:s)
24
25		interp :: String -> [Elem] -> [Elem]
26		interp t = foldr (flip (.)) id (map (ic) t)
27
28		ic '!' = apply
29		ic ';' = push $ Fn apply
30		ic '.' = push $ Fn compose
31		ic '$' = push $ Fn pop
32		ic '\\' = push $ Fn swap
33		ic '+' = push $ Fn add
34		ic '-' = push $ Fn sub
35		ic '%' = push $ Fn sign
36		ic '~' = push $ Fn pick
37		ic '1' = push $ Fn (push $ Int 1)
38		ic ' ' = id
39		ic '\t' = id
40		ic '\n' = id
41		ic '\r' = id

+0

-50

~~src/EquipageQ.hs~~ less more

0		module EquipageQ where
1
2		data Elem = Int Integer
3		\| Fn ([Elem] -> [Elem])
4		\| Marker
5
6		instance Show Elem where
7		show (Int i) = show i
8		show (Fn _) = "<fn>"
9		show (Marker) = "<(>"
10
11		apply (Fn f:s) = f s
12		compose (Fn f1:Fn f2:s) = ((Fn (f1 . f2)):s)
13
14		pop (e:s) = s
15		swap (e1:e2:s) = (e2:e1:s)
16
17		add ((Int a):(Int b):s) = ((Int (a + b)):s)
18		sub ((Int a):(Int b):s) = ((Int (b - a)):s)
19
20		sign (Int a:s) = (Int (if a > 0 then 1 else if a < 0 then -1 else 0):s)
21		pick (Int a:s) = ((if a > 0 then pick' a s else if a < 0 then pick' (0-a) (reverse s) else (Int 0)):s)
22		pick' 1 (s:t) = s
23		pick' n (s:t) = pick' (n-1) t
24
25		define s = define' (id) s
26		define' f (Marker:s) = (Fn f:s)
27		define' f (Fn x:s) = define' (f . x) s
28
29		push e s = (e:s)
30
31		interp :: String -> [Elem] -> [Elem]
32		interp t = foldr (flip (.)) id (map (ic) t)
33
34		ic '!' = apply
35		ic ';' = push $ Fn apply
36		ic '.' = push $ Fn compose
37		ic '$' = push $ Fn pop
38		ic '\\' = push $ Fn swap
39		ic '+' = push $ Fn add
40		ic '-' = push $ Fn sub
41		ic '%' = push $ Fn sign
42		ic '~' = push $ Fn pick
43		ic '1' = push $ Fn (push $ Int 1)
44		ic '(' = push $ Fn (push $ Marker)
45		ic ')' = push $ Fn define
46		ic ' ' = id
47		ic '\t' = id
48		ic '\n' = id
49		ic '\r' = id

+13

-0

src/HasteMain.hs less more

	0	module Main where
	1
	2	import Haste.DOM (withElems, getValue, setProp)
	3	import Haste.Events (onEvent, MouseEvent(Click))
	4
	5	import qualified Language.Equipage as Equipage
	6
	7	main = withElems ["prog", "result", "run-button"] driver
	8
	9	driver [progElem, resultElem, runButtonElem] =
	10	onEvent runButtonElem Click $ \_ -> do
	11	Just prog <- getValue progElem
	12	setProp resultElem "textContent" $ show $ Equipage.interp prog []

+42

-0

src/Language/Equipage.hs less more

	0	module Language.Equipage where
	1
	2	data Elem = Int Integer
	3	\| Fn ([Elem] -> [Elem])
	4
	5	instance Show Elem where
	6	show (Int i) = show i
	7	show (Fn _) = "<fn>"
	8
	9	apply (Fn f:s) = f s
	10	compose (Fn f1:Fn f2:s) = ((Fn (f1 . f2)):s)
	11
	12	pop (e:s) = s
	13	swap (e1:e2:s) = (e2:e1:s)
	14
	15	add ((Int a):(Int b):s) = ((Int (a + b)):s)
	16	sub ((Int a):(Int b):s) = ((Int (b - a)):s)
	17
	18	sign (Int a:s) = (Int (if a > 0 then 1 else if a < 0 then -1 else 0):s)
	19	pick (Int a:s) = ((if a > 0 then pick' a s else if a < 0 then pick' (0-a) (reverse s) else (Int 0)):s)
	20	pick' 1 (s:t) = s
	21	pick' n (s:t) = pick' (n-1) t
	22
	23	push e s = (e:s)
	24
	25	interp :: String -> [Elem] -> [Elem]
	26	interp t = foldr (flip (.)) id (map (ic) t)
	27
	28	ic '!' = apply
	29	ic ';' = push $ Fn apply
	30	ic '.' = push $ Fn compose
	31	ic '$' = push $ Fn pop
	32	ic '\\' = push $ Fn swap
	33	ic '+' = push $ Fn add
	34	ic '-' = push $ Fn sub
	35	ic '%' = push $ Fn sign
	36	ic '~' = push $ Fn pick
	37	ic '1' = push $ Fn (push $ Int 1)
	38	ic ' ' = id
	39	ic '\t' = id
	40	ic '\n' = id
	41	ic '\r' = id

+50

-0

src/Language/EquipageQ.hs less more

	0	module Language.EquipageQ where
	1
	2	data Elem = Int Integer
	3	\| Fn ([Elem] -> [Elem])
	4	\| Marker
	5
	6	instance Show Elem where
	7	show (Int i) = show i
	8	show (Fn _) = "<fn>"
	9	show (Marker) = "<(>"
	10
	11	apply (Fn f:s) = f s
	12	compose (Fn f1:Fn f2:s) = ((Fn (f1 . f2)):s)
	13
	14	pop (e:s) = s
	15	swap (e1:e2:s) = (e2:e1:s)
	16
	17	add ((Int a):(Int b):s) = ((Int (a + b)):s)
	18	sub ((Int a):(Int b):s) = ((Int (b - a)):s)
	19
	20	sign (Int a:s) = (Int (if a > 0 then 1 else if a < 0 then -1 else 0):s)
	21	pick (Int a:s) = ((if a > 0 then pick' a s else if a < 0 then pick' (0-a) (reverse s) else (Int 0)):s)
	22	pick' 1 (s:t) = s
	23	pick' n (s:t) = pick' (n-1) t
	24
	25	define s = define' (id) s
	26	define' f (Marker:s) = (Fn f:s)
	27	define' f (Fn x:s) = define' (f . x) s
	28
	29	push e s = (e:s)
	30
	31	interp :: String -> [Elem] -> [Elem]
	32	interp t = foldr (flip (.)) id (map (ic) t)
	33
	34	ic '!' = apply
	35	ic ';' = push $ Fn apply
	36	ic '.' = push $ Fn compose
	37	ic '$' = push $ Fn pop
	38	ic '\\' = push $ Fn swap
	39	ic '+' = push $ Fn add
	40	ic '-' = push $ Fn sub
	41	ic '%' = push $ Fn sign
	42	ic '~' = push $ Fn pick
	43	ic '1' = push $ Fn (push $ Int 1)
	44	ic '(' = push $ Fn (push $ Marker)
	45	ic ')' = push $ Fn define
	46	ic ' ' = id
	47	ic '\t' = id
	48	ic '\n' = id
	49	ic '\r' = id

+4

-2

src/Main.hs less more

0	0	module Main where
1	1
2	2	import System.Environment
3		import qualified Equipage
4		import qualified EquipageQ
	3
	4	import qualified Language.Equipage as Equipage
	5	import qualified Language.EquipageQ as EquipageQ
	6
5	7
6	8	main = do
7	9	args <- getArgs