Verified Commit 02f168c3 authored by Camil Staps's avatar Camil Staps 🚀

Fix exponentionality in Clean.Types.Parse

parent b609d80d
Pipeline #15049 passed with stage
in 1 minute and 15 seconds
......@@ -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)
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment