Fix exponentionality in Clean.Types.Parse

src/libraries/OS-Independent/Clean/Types/Parse.icl

@@ -19,14 +19,11 @@ import Control.Monad
 from Text.Parsers.Simple.Core import :: Parser, :: Error,
 	instance Functor (Parser t), instance Applicative (Parser t),
 	instance Alternative (Parser t), instance Monad (Parser t),
-	parse, pToken, pSepBy, pList, pSatisfy
+	parse, pToken, pSepBy, pSepBy1, pList, pSatisfy, pPeek
 
 (|<<) infixl 1 :: !(m a) !(m b) -> m a | Monad m
 (|<<) ma mb = ma >>= \a -> mb >>= \_ -> pure a
 
-derive gEq Token
-instance == Token where == a b = a === b
-
 :: Token
 	= TIdent String            // UpperCaseId or FunnyId
 	| TVar String              // LowerCaseId
@@ -47,8 +44,30 @@ instance == Token where == a b = a === b
 	| TBrackOpen | TBrackClose // [ ]
 	| TBraceOpen | TBraceClose // { }
 
-isTIdent (TIdent _) = True; isTIdent _ = False
-isTVar   (TVar   _) = True; isTVar   _ = False
+instance == Token
+where
+	== (TIdent a)  (TIdent b) = a == b
+	== (TVar a)    (TVar b)   = a == b
+	== TArrow      b          = b=:TArrow
+	== TComma      b          = b=:TComma
+	== TStar       b          = b=:TStar
+	== TAnonymous  b          = b=:TAnonymous
+	== TUnboxed    b          = b=:TUnboxed
+	== TStrict     b          = b=:TStrict
+	== TColon      b          = b=:TColon
+	== TUniversalQuantifier b = b=:TUniversalQuantifier
+	== TPipe       b          = b=:TPipe
+	== TAmpersand  b          = b=:TAmpersand
+	== TLtEq       b          = b=:TLtEq
+	== TParenOpen  b          = b=:TParenOpen
+	== TParenClose b          = b=:TParenClose
+	== TBrackOpen  b          = b=:TBrackOpen
+	== TBrackClose b          = b=:TBrackClose
+	== TBraceOpen  b          = b=:TBraceOpen
+	== TBraceClose b          = b=:TBraceClose
+
+isTIdent t = t=:(TIdent _)
+isTVar   t = t=:(TVar _)
 
 tokenize :: ([Char] -> Maybe [Token])
 tokenize = fmap reverse o tkz []
@@ -114,7 +133,7 @@ where
 		<|> liftM (\t -> Type "_List!"  [t]) (bracked (type |<< pToken TStrict))
 		<|> liftM (\t -> Type "_List"   [t]) (bracked type)
 		<|> liftM (\ts -> Type ("_Tuple" +++ toString (length ts)) ts)
-			(parenthised (pSepBy type (pToken TComma)))
+			(parenthised (pSepBy1 type (pToken TComma)))
 		<|> (pToken TStrict >>| argtype)           // ! ignored for now
 		<|> (pToken TAnonymous >>| argtype)        // . ignored for now
 		<|> (unqvar >>| pToken TColon >>| argtype) // u: & friends ignored for now
@@ -136,10 +155,11 @@ where
 
 	addContextAsConstFunction :: (Parser Token Type) -> Parser Token Type
 	addContextAsConstFunction parser =
-		parser >>= \t ->
-		(pure [] <|> optContext) >>= \c -> case c of
-			[] -> pure t
-			c  -> pure $ Func [] t c
+		parser >>= \t -> pPeek >>= \tks -> case tks of
+			[TPipe:_] ->  (pure [] <|> optContext) >>= \c -> case c of
+				[] -> pure t
+				c  -> pure $ Func [] t c
+			_ -> pure t
 
 	context :: Parser Token TypeContext
 	context = pToken TPipe >>| flatten <$> pSepBy context` (pToken TAmpersand)

src/libraries/OS-Independent/Text/Parsers/Simple/Core.dcl

@@ -25,6 +25,7 @@ pFail    :: Parser t a
 pYield   :: a -> Parser t a
 pSatisfy :: (t -> Bool) -> Parser t t
 pError   :: Error -> Parser t a
+pPeek :: Parser t [t]
 
 // Convenience parsers
 (@!) infixr 4 :: (Parser t a) Error -> Parser t a

src/libraries/OS-Independent/Text/Parsers/Simple/Core.icl

@@ -59,6 +59,9 @@ pSatisfy pred = Parser pSatisfy`
     | pred token = ([(token, input)], [])
   pSatisfy` _ = ([], [])
 
+pPeek :: Parser t [t]
+pPeek = Parser \input -> ([(input, input)], [])
+
 pMap :: (a -> b) (Parser t a) -> Parser t b
 pMap f p = pure f <*> p