Commit d39b0fb995f7ba435db2fff32136b7e200685997 - Equipage

+9

-0

impl/equipage.purs/.gitignore less more

	0	/bower_components/
	1	/node_modules/
	2	/.pulp-cache/
	3	/output/
	4	/generated-docs/
	5	/.psc-package/
	6	/.psc*
	7	/.purs*
	8	/.psa*

+10

-0

impl/equipage.purs/Dockerfile less more

	0	FROM node:8.11.4
	1
	2	USER node
	3
	4	ENV NPM_PACKAGES=/home/node/.npm-packages
	5	ENV PATH="${NPM_PACKAGES}/bin:${PATH}"
	6
	7	RUN mkdir $NPM_PACKAGES \
	8	&& echo 'prefix=${NPM_PACKAGES}' >> $HOME/.npmrc \
	9	&& npm install -g bower pulp purescript@0.11.7⏎

+32

-0

impl/equipage.purs/README.md less more

	0	PureScript implementation of Equipage
	1	=====================================
	2
	3	Docker
	4	------
	5
	6	For convenience sake, the PureScript compiler and package managers are provided in a Docker image.
	7
	8	See `docker-compose.yml` and `Dockerfile`.
	9
	10	### Build
	11
	12	$ docker-compose run dev bower install
	13	$ docker-compose run dev pulp build
	14
	15	### Running example Equipage programs
	16
	17	The `eg` folder of this repository is mounted at `/eg` in the container.
	18
	19	$ docker-compose run dev pulp run -- /eg/trivial1.equipage
	20
	21	### Tests
	22
	23	$ docker-compose run dev pulp test
	24
	25	### Compile to a standalone `.js` file
	26
	27	$ docker-compose run dev pulp build --optimise --to Equipage.js
	28
	29	You may then run `Equipage.js` via `node`, as follows:
	30
	31	$ docker-compose run dev node Equipage.js /eg/pop-all-positives.equipage

+22

-0

impl/equipage.purs/bower.json less more

	0	{
	1	"name": "equipage",
	2	"ignore": [
	3	"*/.",
	4	"node_modules",
	5	"bower_components",
	6	"output"
	7	],
	8	"dependencies": {
	9	"purescript-prelude": "^3.3.0",
	10	"purescript-console": "^3.0.0",
	11	"purescript-lists": "^4.12.0",
	12	"purescript-strings": "^3.5.0",
	13	"purescript-assert": "^3.1.0",
	14	"purescript-partial": "^1.2.1",
	15	"purescript-node-fs": "^4.0.1",
	16	"purescript-node-process": "^5.0.0"
	17	},
	18	"devDependencies": {
	19	"purescript-psci-support": "^3.0.0"
	20	}
	21	}

+8

-0

impl/equipage.purs/docker-compose.yml less more

	0	version: '2'
	1	services:
	2	dev:
	3	build: .
	4	volumes:
	5	- ${PWD}:/equipage
	6	- ${PWD}/../../eg:/eg
	7	working_dir: /equipage⏎

+73

-0

impl/equipage.purs/src/Equipage.purs less more

	0	module Equipage (interp, Elem) where
	1
	2	import Prelude (class Show, id, map, negate, otherwise, show, ($), (+), (-), (<), (<<<), (>), (>>>))
	3	import Data.List (List, foldr, fromFoldable, reverse, (:))
	4	import Data.String (toCharArray)
	5
	6	data Elem
	7	= Int Int
	8	\| Fn (List Elem -> List Elem)
	9
	10	instance showElem :: Show Elem where
	11	show (Int i) = show i
	12	show (Fn _) = "<fn>"
	13
	14	apply :: Partial => List Elem -> List Elem
	15	apply (Fn f : s) = f s
	16
	17	compose :: Partial => List Elem -> List Elem
	18	compose (Fn f1 : Fn f2 : s) = Fn (f1 <<< f2) : s
	19
	20	pop :: Partial => List Elem -> List Elem
	21	pop (_ : s) = s
	22
	23	swap :: Partial => List Elem -> List Elem
	24	swap (e1 : e2 : s) = e2 : e1 : s
	25
	26	add :: Partial => List Elem -> List Elem
	27	add (Int a : Int b : s) = Int (a + b) : s
	28
	29	sub :: Partial => List Elem -> List Elem
	30	sub (Int a : Int b : s) = Int (b - a) : s
	31
	32	sign :: Partial => List Elem -> List Elem
	33	sign (Int a : s) = Int x : s
	34	where x \| a > 0 = 1
	35	\| a < 0 = -1
	36	\| otherwise = 0
	37
	38	pick :: Partial => List Elem -> List Elem
	39	pick (Int a : s) = x : s
	40	where x \| a > 0 = pick' a s
	41	\| a < 0 = pick' (0 - a) (reverse s)
	42	\| otherwise = Int 0
	43	pick' 1 (s : _) = s
	44	pick' n (_ : t) = pick' (n - 1) t
	45
	46	push :: Elem -> List Elem -> List Elem
	47	push = (:)
	48
	49	stringToCharList :: String -> List Char
	50	stringToCharList = fromFoldable <<< toCharArray
	51
	52	interp :: Partial => String -> List Elem -> List Elem
	53	interp = interp' <<< stringToCharList
	54
	55	interp' :: Partial => List Char -> List Elem -> List Elem
	56	interp' t = foldr (>>>) id (map ic t)
	57
	58	ic :: Partial => Char -> List Elem -> List Elem
	59	ic '!' = apply
	60	ic ';' = push $ Fn apply
	61	ic '.' = push $ Fn compose
	62	ic '$' = push $ Fn pop
	63	ic '\\' = push $ Fn swap
	64	ic '+' = push $ Fn add
	65	ic '-' = push $ Fn sub
	66	ic '%' = push $ Fn sign
	67	ic '~' = push $ Fn pick
	68	ic '1' = push $ Fn (push $ Int 1)
	69	ic ' ' = id
	70	ic '\t' = id
	71	ic '\n' = id
	72	ic '\r' = id⏎

+26

-0

impl/equipage.purs/src/Main.purs less more

	0	module Main where
	1
	2	import Data.Array (drop)
	3	import Equipage (interp)
	4	import Node.Process (PROCESS, argv)
	5
	6	import Control.Monad.Eff (Eff)
	7	import Control.Monad.Eff.Console (CONSOLE, log, logShow)
	8	import Control.Monad.Eff.Exception (EXCEPTION)
	9	import Data.List (List(Nil))
	10	import Node.Encoding (Encoding(..))
	11	import Node.FS (FS)
	12	import Node.FS.Sync (readTextFile)
	13	import Partial.Unsafe (unsafePartial)
	14	import Prelude (Unit, bind, ($))
	15
	16	main :: forall e. Eff (console :: CONSOLE, exception :: EXCEPTION, fs :: FS, process :: PROCESS \| e) Unit
	17	main = do
	18	args <- argv
	19	let params = drop 2 args
	20	case params of
	21	[fileName] -> do
	22	c <- readTextFile UTF8 fileName
	23	logShow $ unsafePartial $ interp c Nil
	24	_ ->
	25	log "Usage: equipage <equipage-program-text-filename>"

+96

-0

impl/equipage.purs/test/Main.purs less more

	0	module Test.Main where
	1
	2	import Prelude (Unit, discard, show, ($), (==))
	3	import Control.Monad.Eff (Eff)
	4	import Control.Monad.Eff.Console (CONSOLE)
	5	import Test.Assert (ASSERT, assert)
	6	import Equipage (interp)
	7	import Partial.Unsafe (unsafePartial)
	8	import Data.List (List(Nil))
	9
	10	type Spec = { src :: String, out :: String }
	11
	12	one :: Spec
	13	one = { src: "1!", out: "(1 : Nil)"}
	14
	15	apply :: Spec
	16	apply = { src: "1!1!", out: "(1 : 1 : Nil)"}
	17
	18	apply' :: Spec
	19	apply' = { src: "1;!", out: "(1 : Nil)"}
	20
	21	add :: Spec
	22	add = { src: "1!1!+!", out: "(2 : Nil)"}
	23
	24	nop :: Spec
	25	nop = { src: "1! 1!1!+! \
	26	\ 1!1!+!1!+!" , out: "(3 : 2 : 1 : Nil)"}
	27
	28	swapPop :: Spec
	29	swapPop = { src: "1! 1!1!+! 1!1!+!1!+! \\!$!", out: "(3 : 1 : Nil)"}
	30
	31	sub :: Spec
	32	sub = { src: "1! 1!1!+! 1!1!+!1!+! +!+! 1!-!", out: "(5 : Nil)"}
	33
	34	sign :: Spec
	35	sign = {src: "1!1!+!1!+! %!", out : "(1 : Nil)"}
	36
	37	sign' :: Spec
	38	sign' = {src: "1!1!-!1!-! %!", out: "(-1 : Nil)"}
	39
	40	sign'' :: Spec
	41	sign'' = {src: "1!1!-! %!", out: "(0 : Nil)"}
	42
	43	pick :: Spec
	44	pick = {src: "1! 1!1!+! 1!1!+!1!+! 1! ~!", out: "(3 : 3 : 2 : 1 : Nil)"}
	45
	46	pick' :: Spec
	47	pick' = {src: "1! 1!1!+! 1!1!+!1!+! 1!1!+! ~!", out: "(2 : 3 : 2 : 1 : Nil)"}
	48
	49	pick'' :: Spec
	50	pick'' = {src: "1! 1!1!+! 1!1!+!1!+! 1!1!-!1!-! ~!", out: "(1 : 3 : 2 : 1 : Nil)"}
	51
	52	pick''' :: Spec
	53	pick''' = {src: "1! 1!1!+! 1!1!+!1!+! 1!1!-!1!-!1!-! ~!", out: "(2 : 3 : 2 : 1 : Nil)"}
	54
	55	pick'''' :: Spec
	56	pick'''' = {src: "1! 1!1!+! 1!1!+!1!+! 1!1!-! ~!", out: "(0 : 3 : 2 : 1 : Nil)"}
	57
	58	compose :: Spec
	59	compose = {src: "1! 1!1!+! 1!1!+!1!+! \\$.! !", out: "(3 : 1 : Nil)"}
	60
	61	call :: Spec
	62	call = {src: "11+.!.!\
	63	\ 1!1!-!1!-!~!;!\
	64	\ 1!1!-!1!-!~!;!\
	65	\ 1!1!-!1!-!~!;!", out: "(2 : 2 : 2 : <fn> : Nil)"}
	66
	67	call' :: Spec
	68	call' = {src: "1~+.!.!\
	69	\ 1!\
	70	\ 1!1!-!1!-!~!;!\
	71	\ 1!1!-!1!-!~!;!\
	72	\ 1!1!-!1!-!~!;!", out: "(8 : <fn> : Nil)"}
	73
	74	main :: forall e. Eff (console :: CONSOLE, assert :: ASSERT \| e) Unit
	75	main = do
	76	test one
	77	test apply
	78	test apply'
	79	test add
	80	test nop
	81	test swapPop
	82	test sub
	83	test sign
	84	test sign'
	85	test sign''
	86	test pick
	87	test pick'
	88	test pick''
	89	test pick'''
	90	test pick''''
	91	test compose
	92	test call
	93	test call'
	94	where test s = assert $ show (unsafePartial $ interp s.src Nil) == s.out
	95	⏎