From 1cba9b0066b9a884d906653f2ddf6fd768f8dc1d Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 31 Jan 2023 14:07:31 +0100
Subject: Use <<|> instead of <|> in parser to reduce memory usage

---
 snug-clean/src/Snug/Parse.icl | 41 +++++++++++++++++++++++------------------
 1 file changed, 23 insertions(+), 18 deletions(-)

(limited to 'snug-clean')

diff --git a/snug-clean/src/Snug/Parse.icl b/snug-clean/src/Snug/Parse.icl
index 75d9295..64331c5 100644
--- a/snug-clean/src/Snug/Parse.icl
+++ b/snug-clean/src/Snug/Parse.icl
@@ -12,9 +12,14 @@ import Data.Tuple
 import qualified Text
 from Text import class Text, instance Text String
 import Text.Parsers.Simple.Core
+import qualified Text.Parsers.Simple.Core
 
 import Snug.Syntax
 
+// override infix priority to use easily with <$>
+(<<|>) infixr 3 :: !(Parser t a) (Parser t a) -> Parser t a
+(<<|>) left right = left 'Text.Parsers.Simple.Core'. <<|> right
+
 parseSnug :: ![Char] -> MaybeError String [Definition]
 parseSnug cs = case parse (many definition`) (filterComments (lex cs)) of
 	Left errors -> Error ('Text'.join "; " errors)
@@ -30,10 +35,10 @@ where
 			(pToken (TIdent "data") *> typeIdent)
 			(fromMaybe [] <$> optional (simpleList typeVarIdent))
 			(list simpleConstructorDef constructorDef)
-		<|> liftM2 TypeDef
+		<<|> liftM2 TypeDef
 			(pToken (TIdent "type") *> typeIdent)
 			simpleOrParenthesizedType
-		<|> liftM4 FunDef
+		<<|> liftM4 FunDef
 			(pToken (TIdent "fun") *> symbolIdent)
 			(simpleList (parenthesized typedArgument))
 			(pToken TColon *> type)
@@ -50,20 +55,20 @@ complexType = liftM2 (foldl TyApp) simpleType (some simpleOrParenthesizedType)
 simpleType :: Parser Token Type
 simpleType
 	= Type <$> typeIdent
-	<|> TyVar <$> typeVarIdent
+	<<|> TyVar <$> typeVarIdent
 
 type :: Parser Token Type
-type = complexType <|> simpleType
+type = complexType <<|> simpleType
 
 simpleOrParenthesizedType :: Parser Token Type
-simpleOrParenthesizedType = simpleType <|> parenthesized complexType
+simpleOrParenthesizedType = simpleType <<|> parenthesized complexType
 
 complexExpression :: Parser Token Expression
 complexExpression
 	= liftM2 Case
 		(pToken (TIdent "case") *> simpleOrParenthesizedExpression)
 		(nonEmpty (simpleList (parenthesized caseAlternative)))
-	<|> liftM2 (foldl ExpApp)
+	<<|> liftM2 (foldl ExpApp)
 		simpleExpression
 		(some simpleOrParenthesizedExpression)
 where
@@ -73,28 +78,28 @@ where
 		= liftM2 ConstructorPattern constructorIdent (many simpleOrParenthesizedPattern)
 	simplePattern
 		= pToken TUnderscore $> Wildcard
-		<|> BasicValuePattern <$> basicValue
-		<|> IdentPattern <$> symbolIdent
-		<|> liftM2 ConstructorPattern constructorIdent (pure [])
-	simpleOrParenthesizedPattern = simplePattern <|> parenthesized complexPattern
-	pattern = complexPattern <|> simplePattern
+		<<|> BasicValuePattern <$> basicValue
+		<<|> IdentPattern <$> symbolIdent
+		<<|> liftM2 ConstructorPattern constructorIdent (pure [])
+	simpleOrParenthesizedPattern = simplePattern <<|> parenthesized complexPattern
+	pattern = complexPattern <<|> simplePattern
 
 simpleExpression :: Parser Token Expression
 simpleExpression
 	= BasicValue <$> basicValue
-	<|> Symbol <$> symbolIdent
-	<|> Constructor <$> constructorIdent
+	<<|> Symbol <$> symbolIdent
+	<<|> Constructor <$> constructorIdent
 
 simpleOrParenthesizedExpression :: Parser Token Expression
-simpleOrParenthesizedExpression = simpleExpression <|> parenthesized expression
+simpleOrParenthesizedExpression = simpleExpression <<|> parenthesized expression
 
 expression :: Parser Token Expression
-expression = complexExpression <|> simpleExpression
+expression = complexExpression <<|> simpleExpression
 
 basicValue :: Parser Token BasicValue
 basicValue
 	= (\(TInt i) -> BVInt i) <$> pSatisfy (\t -> t=:(TInt _))
-	<|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _))
+	<<|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _))
 
 typeIdent :: Parser Token TypeIdent
 typeIdent = fromIdent <$> pSatisfy isUpperCaseIdent
@@ -108,7 +113,7 @@ typeVarIdent = fromIdent <$> pSatisfy isLowerCaseIdent
 symbolIdent :: Parser Token SymbolIdent
 symbolIdent
 	= fromIdent <$> pSatisfy isLowerCaseIdent
-	<|> fromIdent <$> pSatisfy isFunnyIdent
+	<<|> fromIdent <$> pSatisfy isFunnyIdent
 
 fromIdent (TIdent id) :== id
 
@@ -128,7 +133,7 @@ parenthesized :: !(Parser Token a) -> Parser Token a
 parenthesized p = pToken TParenOpen *> p <* pToken TParenClose
 
 list :: !(Parser Token a) !(Parser Token a) -> Parser Token [a]
-list simpleElem elem = simpleList (simpleElem <|> parenthesized elem)
+list simpleElem elem = simpleList (simpleElem <<|> parenthesized elem)
 
 simpleList :: !(Parser Token a) -> Parser Token [a]
 simpleList simpleElem = parenthesized (many simpleElem)
-- 
cgit v1.2.3