From 83bc96feb82ce6bbba2cb82b83b4228c5f24f185 Mon Sep 17 00:00:00 2001 From: Mart Lubbers 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