Commit d185f867 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Disallow functional patterns in all but function patterns - fixes #780

parent c7cc8e01
Change log for curry-frontend Change log for curry-frontend
============================= =============================
Version 0.3.10 (under development)
==================================
Version 0.3.9 Version 0.3.9
============= =============
* Fixed bug when using functional patterns in `case`-expressions.
Functional patterns are only allowed in the patterns of a function
definition and forbidden elsewhere, i.e., in `case`-expressions,
`do`-sequences, list comprehensions or lambda expressions.
* Implementation of module pragmas added. Module pragmas of the following * Implementation of module pragmas added. Module pragmas of the following
types are now parsed and represented in the abstract syntax tree: types are now parsed and represented in the abstract syntax tree:
......
...@@ -713,9 +713,10 @@ checkParen ...@@ -713,9 +713,10 @@ checkParen
> checkExpr p (Typed e ty) = flip Typed ty `liftM` checkExpr p e > checkExpr p (Typed e ty) = flip Typed ty `liftM` checkExpr p e
> checkExpr p (Tuple pos es) = Tuple pos `liftM` mapM (checkExpr p) es > checkExpr p (Tuple pos es) = Tuple pos `liftM` mapM (checkExpr p) es
> checkExpr p (List pos es) = List pos `liftM` mapM (checkExpr p) es > checkExpr p (List pos es) = List pos `liftM` mapM (checkExpr p) es
> checkExpr p (ListCompr pos e qs) = withLocalEnv $ > checkExpr p (ListCompr pos e qs)
> = withLocalEnv $ liftM2 (flip (ListCompr pos))
> -- Note: must be flipped to insert qs into RenameEnv first > -- Note: must be flipped to insert qs into RenameEnv first
> liftM2 (flip (ListCompr pos)) (mapM (checkStatement p) qs) (checkExpr p e) > (mapM (checkStatement "list comprehension" p) qs) (checkExpr p e)
> checkExpr p (EnumFrom e) = EnumFrom `liftM` checkExpr p e > checkExpr p (EnumFrom e) = EnumFrom `liftM` checkExpr p e
> checkExpr p (EnumFromThen e1 e2) = > checkExpr p (EnumFromThen e1 e2) =
> liftM2 EnumFromThen (checkExpr p e1) (checkExpr p e2) > liftM2 EnumFromThen (checkExpr p e1) (checkExpr p e2)
...@@ -732,12 +733,12 @@ checkParen ...@@ -732,12 +733,12 @@ checkParen
> liftM2 LeftSection (checkExpr p e) (checkOp op) > liftM2 LeftSection (checkExpr p e) (checkOp op)
> checkExpr p (RightSection op e) = > checkExpr p (RightSection op e) =
> liftM2 RightSection (checkOp op) (checkExpr p e) > liftM2 RightSection (checkOp op) (checkExpr p e)
> checkExpr p (Lambda r ts e) = inNestedScope $ > checkExpr p (Lambda r ts e) = inNestedScope $ liftM2 (Lambda r)
> liftM2 (Lambda r) (mapM (bindPattern p) ts) (checkExpr p e) > (mapM (bindPattern "lambda expression" p) ts) (checkExpr p e)
> checkExpr p (Let ds e) = inNestedScope $ > checkExpr p (Let ds e) = inNestedScope $
> liftM2 Let (checkDeclGroup bindVarDecl ds) (checkExpr p e) > liftM2 Let (checkDeclGroup bindVarDecl ds) (checkExpr p e)
> checkExpr p (Do sts e) = withLocalEnv $ > checkExpr p (Do sts e) = withLocalEnv $
> liftM2 Do (mapM (checkStatement p) sts) (checkExpr p e) > liftM2 Do (mapM (checkStatement "do sequence" p) sts) (checkExpr p e)
> checkExpr p (IfThenElse r e1 e2 e3) = > checkExpr p (IfThenElse r e1 e2 e3) =
> liftM3 (IfThenElse r) (checkExpr p e1) (checkExpr p e2) (checkExpr p e3) > liftM3 (IfThenElse r) (checkExpr p e1) (checkExpr p e2) (checkExpr p e3)
> checkExpr p (Case r ct e alts) = > checkExpr p (Case r ct e alts) =
...@@ -815,15 +816,35 @@ checkParen ...@@ -815,15 +816,35 @@ checkParen
> -- scope has to be nested one level. > -- scope has to be nested one level.
> -- * Because statements are processed list-wise, inNestedEnv can not be > -- * Because statements are processed list-wise, inNestedEnv can not be
> -- used as this nesting must be visible to following statements. > -- used as this nesting must be visible to following statements.
> checkStatement :: Position -> Statement -> SCM Statement > checkStatement :: String -> Position -> Statement -> SCM Statement
> checkStatement p (StmtExpr pos e) = StmtExpr pos `liftM` checkExpr p e > checkStatement _ p (StmtExpr pos e) = StmtExpr pos `liftM` checkExpr p e
> checkStatement p (StmtBind pos t e) = > checkStatement s p (StmtBind pos t e) =
> liftM2 (flip (StmtBind pos)) (checkExpr p e) (incNesting >> bindPattern p t) > liftM2 (flip (StmtBind pos)) (checkExpr p e) (incNesting >> bindPattern s p t)
> checkStatement _ (StmtDecl ds) = > checkStatement _ _ (StmtDecl ds) =
> StmtDecl `liftM` (incNesting >> checkDeclGroup bindVarDecl ds) > StmtDecl `liftM` (incNesting >> checkDeclGroup bindVarDecl ds)
> bindPattern :: Position -> Pattern -> SCM Pattern > bindPattern :: String -> Position -> Pattern -> SCM Pattern
> bindPattern p t = checkPattern p t >>= addBoundVariables True > bindPattern s p t = do
> t' <- checkPattern p t
> banFPTerm s p t'
> addBoundVariables True t'
> banFPTerm :: String -> Position -> Pattern -> SCM ()
> banFPTerm _ _ (LiteralPattern _) = ok
> banFPTerm _ _ (NegativePattern _ _) = ok
> banFPTerm _ _ (VariablePattern _) = ok
> banFPTerm s p (ConstructorPattern _ ts) = mapM_ (banFPTerm s p) ts
> banFPTerm s p (InfixPattern t1 _ t2) = mapM_ (banFPTerm s p) [t1, t2]
> banFPTerm s p (ParenPattern t) = banFPTerm s p t
> banFPTerm s p (TuplePattern _ ts) = mapM_ (banFPTerm s p) ts
> banFPTerm s p (ListPattern _ ts) = mapM_ (banFPTerm s p) ts
> banFPTerm s p (AsPattern _ t) = banFPTerm s p t
> banFPTerm s p (LazyPattern _ t) = banFPTerm s p t
> banFPTerm s p (RecordPattern _ mt) = maybe ok (banFPTerm s p) mt
> banFPTerm s p pat@(FunctionPattern _ _)
> = report $ errUnsupportedFuncPattern s p pat
> banFPTerm s p pat@(InfixFuncPattern _ _ _)
> = report $ errUnsupportedFuncPattern s p pat
> checkOp :: InfixOp -> SCM InfixOp > checkOp :: InfixOp -> SCM InfixOp
> checkOp op = do > checkOp op = do
...@@ -845,7 +866,7 @@ checkParen ...@@ -845,7 +866,7 @@ checkParen
> checkAlt :: Alt -> SCM Alt > checkAlt :: Alt -> SCM Alt
> checkAlt (Alt p t rhs) = inNestedScope $ > checkAlt (Alt p t rhs) = inNestedScope $
> liftM2 (Alt p) (bindPattern p t) (checkRhs rhs) > liftM2 (Alt p) (bindPattern "case expression" p t) (checkRhs rhs)
> addBoundVariables :: QuantExpr t => Bool -> t -> SCM t > addBoundVariables :: QuantExpr t => Bool -> t -> SCM t
> addBoundVariables checkDuplicates ts = do > addBoundVariables checkDuplicates ts = do
...@@ -981,8 +1002,8 @@ to \texttt{(apply (id id) 10)}. ...@@ -981,8 +1002,8 @@ to \texttt{(apply (id id) 10)}.
> checkFPTerm p (AsPattern _ t) = checkFPTerm p t > checkFPTerm p (AsPattern _ t) = checkFPTerm p t
> checkFPTerm p t@(LazyPattern _ _) = report $ errUnsupportedFPTerm "Lazy" p t > checkFPTerm p t@(LazyPattern _ _) = report $ errUnsupportedFPTerm "Lazy" p t
> checkFPTerm p t@(RecordPattern _ _) = report $ errUnsupportedFPTerm "Record" p t > checkFPTerm p t@(RecordPattern _ _) = report $ errUnsupportedFPTerm "Record" p t
> checkFPTerm _ (FunctionPattern _ _) = ok -- dot not check again > checkFPTerm _ (FunctionPattern _ _) = ok -- do not check again
> checkFPTerm _ (InfixFuncPattern _ _ _) = ok -- dot not check again > checkFPTerm _ (InfixFuncPattern _ _ _) = ok -- do not check again
\end{verbatim} \end{verbatim}
Miscellaneous functions. Miscellaneous functions.
...@@ -1022,6 +1043,11 @@ Error messages. ...@@ -1022,6 +1043,11 @@ Error messages.
> <+> text "patterns are not supported inside a functional pattern." > <+> text "patterns are not supported inside a functional pattern."
> $+$ ppPattern 0 pat > $+$ ppPattern 0 pat
> errUnsupportedFuncPattern :: String -> Position -> Pattern -> Message
> errUnsupportedFuncPattern s p pat = posMessage p $
> text "Functional patterns are not supported inside a" <+> text s <> dot
> $+$ ppPattern 0 pat
> errPrecedenceOutOfRange :: Position -> Integer -> Message > errPrecedenceOutOfRange :: Position -> Integer -> Message
> errPrecedenceOutOfRange p i = posMessage p $ hsep $ map text > errPrecedenceOutOfRange p i = posMessage p $ hsep $ map text
> ["Precedence of out range:", show i] > ["Precedence of out range:", show i]
......
{-# LANGUAGE FunctionalPatterns #-}
firstLastCaseFun ([x] ++ _ ++ [y]) = (x, y)
firstLastCase xs = case xs of
([x] ++ _ ++ [y]) -> (x, y)
firstLastLambda xs = (\([x] ++ _ ++ [y]) -> (x, y)) xs
firstLastListcomp xs = [ (x, y) | ([x] ++ _ ++ [y]) <- xs ]
firstLastDoseq xs = do
([x] ++ _ ++ [y]) <- return xs
return (x, y)
{-# LANGUAGE FunctionalPatterns, Records #-}
type Foo = { foo :: Bool } type Foo = { foo :: Bool }
f1 (id v@x) = x f1 (id v@x) = x
......
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