From 83bc96feb82ce6bbba2cb82b83b4228c5f24f185 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 27 Mar 2019 08:25:26 +0100
Subject: [PATCH] tuples are slow in parsing

---
 .gitignore         |  2 ++
 Makefile           |  2 +-
 parse.icl          | 34 +++++++++++++++-------------------
 tests/preamble.mfp |  2 +-
 4 files changed, 19 insertions(+), 21 deletions(-)

diff --git a/.gitignore b/.gitignore
index 77a7d2c..f89feb6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,6 @@
 a.out
 Clean System Files
 minfp
+* Time Profile.pcl
 *.o
+*.prj
diff --git a/Makefile b/Makefile
index 5b9cf37..d95f482 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 CLM?=clm
-CLMFLAGS?=-nr
+CLMFLAGS?=-nr -pt
 CLMLIBS?=-IL Platform
 
 all: minfp
diff --git a/parse.icl b/parse.icl
index 956ca60..da55517 100644
--- a/parse.icl
+++ b/parse.icl
@@ -17,9 +17,8 @@ import ast
 (<:>) infixl 0 :: a (m [a]) -> m [a] | Functor m
 (<:>) l r = (\xs->[l:xs]) <$> r
 
-:: Token
-	= TTEq | TTSemiColon | TTLambda | TTDot | TTBrackOpen | TTBrackClose
-	| TTComma | TTBool Bool | TTInt Int | TTOp [Char] | TTIdent [Char]
+:: Token = TTSemiColon | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int
+	| TTOp [Char] | TTIdent [Char]
 
 derive gEq Token
 derive gPrint Token
@@ -44,18 +43,14 @@ lex ['-',t:ts]
 lex [t:ts]
 	| isSpace t = lex ts
 	| isDigit t
-		# (i, ts) = span isDigit [t:ts]
-		= TTInt (toInt (toString i)) <:> lex ts
+		# (d, ts) = span isDigit [t:ts]
+		= TTInt (toInt (toString d)) <:> lex ts
 	| isAlpha t
-		# (i, ts) = span isAlpha [t:ts]
-		= TTIdent i <:> lex ts
+		# (d, ts) = span isAlpha [t:ts]
+		= TTIdent d <:> lex ts
 	| isOp t
-		# (i, ts) = span isOp [t:ts]
-		| i =: ['='] = TTEq <:> lex ts
-		| i =: [','] = TTComma <:> lex ts
-		| i =: ['.'] = TTDot <:> lex ts
-		| i =: ['\\'] = TTLambda <:> lex ts
-		= TTOp i <:> lex ts
+		# (d, ts) = span isOp [t:ts]
+		= TTOp d <:> lex ts
 	= Left ["Unexpected: " +++ toString t +++ " ord: " +++ toString (toInt t)]
 where
 	isOp c = isMember c ['!@#$%^&*=+/?-_|\\\'",<>.:']
@@ -97,6 +92,7 @@ where
 
 	pId = (\(TTIdent i)->i) <$> pTop ? (\t->t=:(TTIdent _))
 	pOp = (\(TTOp i)->i) <$> pTop ? (\t->t=:(TTOp _))
+	pInt = (\(TTInt i)->i) <$> pTop ? (\t->t=:(TTInt _))
 	pBrack p = pToken TTBrackOpen *> p <* pToken TTBrackClose
 
 	pFunction :: Parser ([Char], [[Char]], [Token])
@@ -104,14 +100,14 @@ where
 		=   (\x y z->(x, y, z))
 		<$> (pFunId <|> pId)
 		<*> many pId
-		<*  pToken TTEq
+		<*  pToken (TTOp ['='])
 		<*> many (pTop ? ((=!=)TTSemiColon))
 		<*  pToken TTSemiColon
 	
 	pFunId :: Parser [Char]
 	pFunId = pOp
 		>>= \i->pChainr <$ pId ? ((==) ['ifxr']) <|> pChainl <$ pId ? ((==)['ifxl'])
-		>>= \p->(\(TTInt i)->i) <$> pTop ? (\t->t=:(TTInt _))
+		>>= \p->pInt
 		>>= \s->modify (\t->{t & ifxs=[(p (App o App (Var i) <$ pOp ? ((==)i)), s):t.ifxs]})
 		>>| pure i
 
@@ -119,11 +115,11 @@ where
 	pExpression = getState >>= \{ifxs}->flip (foldr ($))
 			(map fst $ sortBy (on (<) snd) ifxs)
 		$   pChainl (pure App)
-		$   Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression
-		<|> pBrack (   Tuple <$> pExpression <* pToken TTComma <*> pExpression
+		$   Lambda <$ pToken (TTOp ['\\']) <*> pId <* pToken (TTOp ['.']) <*> pExpression
+		<|> pBrack (   Tuple <$> pExpression <* pToken (TTOp [',']) <*> pExpression
 			       <|> Var <$> pOp
 			       <|> pExpression)
-		<|> (\(TTInt i)->Lit (Int i)) <$> pTop ? (\t->t=:(TTInt _))
+		<|> Lit o Int <$> pInt
 		<|> (\(TTBool i)->Lit (Bool i)) <$> pTop ? (\t->t=:(TTBool _))
-		<|> (\x->Var ['_':x]) <$ pId ? ((==)['code']) <*> pId
+		<|> (\x->Var ['_':x]) <$ pToken (TTIdent ['code']) <*> pId
 		<|> Var <$> pId
diff --git a/tests/preamble.mfp b/tests/preamble.mfp
index 176004a..1ddd4e2 100644
--- a/tests/preamble.mfp
+++ b/tests/preamble.mfp
@@ -29,4 +29,4 @@ uncurry f t = f (fst t) (snd t);
 return a = \s. (a, s);
 >>= ifxr 0 ma atmb = \s. uncurry atmb (ma s);
 
-start = fst ((return 41 >>= \x. return (x + 1)) 4);
+start = 42; //fst ((return 41 >>= \x. return (x + 1)) 4);
-- 
2.20.1