From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 3 Apr 2019 07:25:34 +0000 (+0200)
Subject: signal
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=557bc82b39e6a96de08324a3c040e35dd0224f02;p=clean-tests.git

signal
---

diff --git a/exprparse/test.icl b/exprparse/test.icl
index 72f4de9..d71664d 100644
--- a/exprparse/test.icl
+++ b/exprparse/test.icl
@@ -1,32 +1,45 @@
 module test
 
 import StdEnv
-
+import Data.Maybe
 import Data.Functor
+import Data.Tuple
+import Data.List
 import Control.Applicative
+import Control.Monad
+
+import Text.Parsers.Simple.ParserCombinators
 
-import Text.Parsers.Simple.Core
-import Text.Parsers.Simple.Chars
+operators :: [[Char]]
+operators =
+	[ ['+-']
+	, ['*/']
+	, ['^']
+	]
 
-preprocess :: [Char] -> [Char]
-preprocess c = ['((((':foldr prep ['))))'] c]
+preprocess :: [[Char]] [Char] -> [Char]
+preprocess ops c = rep '(' maxb (foldr prep (rep ')' maxb []) c)
 where
-	prep '(' cs = ['(','(','(','(':cs]
-	prep ')' cs = [')',')',')',')':cs]
-	prep '^' cs = [')','^','(':cs]
-	prep '*' cs = [')',')','*','(','(':cs]
-	prep '/' cs = [')',')','/','(','(':cs]
-	prep '+' cs = [')',')',')','+','(','(','(':cs]
-	prep '-' cs = [')',')',')','-','(','(','(':cs]
-	prep c cs   = [c:cs]
+	maxb = length ops + 1
+
+	rep :: Char Int [Char] -> [Char]
+	rep c 0 r = r
+	rep c i r = [c:rep c (i-1) r]
+
+	prep '(' cs = rep '(' maxb cs
+	prep ')' cs = rep ')' maxb cs
+	prep c cs = maybe [c:cs] (\(_, s)->rep ')' s [c:rep '(' s cs])
+		(find (isMember c o fst) (zip2 ops [maxb-1,maxb-2..0]))
 
 :: Expr = BinOp Expr Char Expr | Lit Int | Var [Char]
 
 parseExpr :: Parser Char Expr
-parseExpr
-	=   BinOp <$ pToken '(' <*> parseExpr <*> pOneOf ['^*/+-'] <*> parseExpr <* pToken ')'
+parseExpr = flip pChainl1 (flip BinOp <$> pOneOf ['+^-/*'])
+	(   Lit o toInt o toString <$> some pDigit
 	<|> Var <$> some pAlpha
-	<|> Lit o toInt o toString <$> some pDigit
+	<|> pToken '(' *> parseExpr <* pToken ')'
+	)
 
-Start = parse parseExpr (preprocess ['a'])
-//Start = parse parseExpr (preprocess ['a*b+c^d/e'])
+//Start = parse parseExpr (preprocess ['a'])
+//Start = preprocess operators ['a*1']
+Start = runParser parseExpr (preprocess operators ['5+5*5'])
diff --git a/parseclass/pc.icl b/parseclass/pc.icl
index d9b5959..8b4d5ec 100644
--- a/parseclass/pc.icl
+++ b/parseclass/pc.icl
@@ -70,8 +70,7 @@ pBracket p = pToken '(' *> p <* pToken ')'
 
 eparser :: Parser Char (v T) | lit v
 eparser
-	= litparser
-
+	= lit <$> litparser
 
 litparser :: Parser Char T
 litparser
diff --git a/signal/test.icl b/signal/test.icl
new file mode 100644
index 0000000..bc33213
--- /dev/null
+++ b/signal/test.icl
@@ -0,0 +1,20 @@
+module test
+
+import StdEnv
+import Data.Error
+import System.Signal
+import System.OSError
+
+Start w
+	= case signalInstall 2 w of
+		(Error (_, m), w) = "signalInstall: " +++ toString m
+		(Ok h, w)
+			#! w = sleep 5 w
+			= case signalPoll h w of
+				(Error m, h, w) = "signalPoll: " +++ m
+				(Ok s, h, w) = "signalState: " +++ toString s
+
+sleep :: !Int !*env -> (!Int, !*env)
+sleep _ _ = code {
+		ccall sleep "I:I:A"
+	}