2012-12-26 22:07:09 +00:00
|
|
|
|
2013-07-04 09:36:08 +00:00
|
|
|
module Parse.Pattern (term, expr) where
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2013-06-27 16:55:01 +00:00
|
|
|
import Control.Applicative ((<$>),(<*>),pure)
|
2012-06-10 04:21:16 +00:00
|
|
|
import Control.Monad
|
2012-11-25 04:49:56 +00:00
|
|
|
import Control.Monad.State
|
2012-12-25 08:39:18 +00:00
|
|
|
import Data.Char (isUpper)
|
2013-07-22 12:40:32 +00:00
|
|
|
import Data.List (intercalate)
|
2012-11-25 04:49:56 +00:00
|
|
|
import Text.Parsec hiding (newline,spaces,State)
|
|
|
|
import Text.Parsec.Indent
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2013-06-23 08:36:23 +00:00
|
|
|
import Parse.Helpers
|
|
|
|
import Parse.Literal
|
2013-06-14 02:15:40 +00:00
|
|
|
import qualified SourceSyntax.Pattern as Pattern
|
2013-08-02 23:09:06 +00:00
|
|
|
import SourceSyntax.Everything hiding (tuple)
|
2013-06-23 08:36:23 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
|
|
|
|
basic :: IParser Pattern
|
2013-06-23 08:36:23 +00:00
|
|
|
basic = choice
|
|
|
|
[ char '_' >> return PAnything
|
|
|
|
, do v <- var
|
|
|
|
return $ case v of
|
|
|
|
"True" -> PLiteral (Boolean True)
|
|
|
|
"False" -> PLiteral (Boolean False)
|
|
|
|
c : _ -> if isUpper c then PData v [] else PVar v
|
2013-10-02 23:55:46 +00:00
|
|
|
, PLiteral <$> literal
|
2013-06-23 08:36:23 +00:00
|
|
|
]
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
asPattern :: Pattern -> IParser Pattern
|
2013-06-07 06:16:46 +00:00
|
|
|
asPattern pattern = do
|
|
|
|
var <- optionMaybe (try (whitespace >> reserved "as" >> whitespace >> lowVar))
|
|
|
|
return $ case var of
|
2013-06-14 02:15:40 +00:00
|
|
|
Just v -> PAlias v pattern
|
|
|
|
Nothing -> pattern
|
2013-06-06 09:27:20 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
record :: IParser Pattern
|
|
|
|
record = PRecord <$> brackets (commaSep1 lowVar)
|
2012-12-26 22:07:09 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
tuple :: IParser Pattern
|
|
|
|
tuple = do ps <- parens (commaSep expr)
|
|
|
|
return $ case ps of { [p] -> p; _ -> Pattern.tuple ps }
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
list :: IParser Pattern
|
|
|
|
list = Pattern.list <$> braces (commaSep expr)
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
term :: IParser Pattern
|
2013-06-23 08:36:23 +00:00
|
|
|
term =
|
|
|
|
(choice [ record, tuple, list, basic ]) <?> "pattern"
|
2012-06-10 04:21:16 +00:00
|
|
|
|
2012-11-25 04:49:56 +00:00
|
|
|
patternConstructor :: IParser Pattern
|
2013-06-23 08:36:23 +00:00
|
|
|
patternConstructor = do
|
2013-07-22 12:40:32 +00:00
|
|
|
v <- intercalate "." <$> dotSep1 capVar
|
2013-06-23 08:36:23 +00:00
|
|
|
case v of
|
|
|
|
"True" -> return $ PLiteral (Boolean True)
|
|
|
|
"False" -> return $ PLiteral (Boolean False)
|
|
|
|
_ -> PData v <$> spacePrefix term
|
2012-10-10 21:39:59 +00:00
|
|
|
|
2013-06-14 02:15:40 +00:00
|
|
|
expr :: IParser Pattern
|
|
|
|
expr = do
|
|
|
|
patterns <- consSep1 (patternConstructor <|> term)
|
|
|
|
asPattern (foldr1 Pattern.cons patterns) <?> "pattern"
|