<commit_before>
module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) where

import Ast
import Context
import Control.Applicative ((<$>),(<*>))
import Control.Monad
import Control.Monad.State
import Data.Char (isUpper)
import Guid
import Text.Parsec hiding (newline,spaces,State)
import Text.Parsec.Indent
import Parse.Library

patternBasic :: IParser Pattern
patternBasic =
    choice [ char '_' >> return PAnything
           , do x@(c:_) <- var
                return $ if isUpper c then PData x [] else PVar x
           ]

patternRecord :: IParser Pattern
patternRecord = PRecord <$> brackets (commaSep1 lowVar)

patternTuple :: IParser Pattern
patternTuple = do ps <- parens (commaSep patternExpr)
                  return $ case ps of { [p] -> p; _ -> ptuple ps }

patternList :: IParser Pattern
patternList = plist <$> braces (commaSep patternExpr)

patternTerm :: IParser Pattern
patternTerm = choice [ patternRecord, patternTuple, patternList, patternBasic ]
           <?> "pattern"

patternConstructor :: IParser Pattern
patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

patternExpr :: IParser Pattern
patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern"

makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr
makeLambda pats body = go (reverse pats) body
    where go [] body = return body
          go (p:ps) body@(C t s _) = do
            (x,e) <- extract p body
            go ps (C t s $ Lambda x e)
          
extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)
extract pattern body@(C t s _) =
  let ctx = C t s in
  let fn x e = (x,e) in
  case pattern of
    PAnything -> return $ fn "_" body
    PVar x -> return $ fn x body
    PData name ps -> do
        x <- guid
        let a = '_' : show x
        return . fn a . ctx $ Case (ctx (Var a)) [(pattern, body)]
    PRecord fs -> do
        x <- guid
        let a = '_' : show x
            toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)
        return . fn a . ctx $ Let (map toDef fs) body

extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)
extracts ps body = go [] (reverse ps) body
    where go args [] body = return (args, body)
          go args (p:ps) body = do (x,e) <- extract p body
                                   go (x:args) ps e

flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])
flattenPatterns patterns exp@(C t s _) =
  let ctx = C t s in
  case patterns of
    PVar f : args -> do
        (as,e) <- extracts args exp
        return . return $
               if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]
                                else [ FnDef f as e ]

    [p] -> return `liftM` matchSingle p exp p

    _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++
                ") cannot be used on the left-hand side of an assign statement."

matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]
matchSingle pat exp@(C t s _) p =
  let ctx = C t s in
  case p of
    PData _ ps -> do x <- guid
                     let v = '_' : show x
                     dss <- mapM (matchSingle p . ctx $ Var v) ps
                     return (FnDef v [] exp : concat dss)

    PVar x ->
        return [ FnDef x [] (ctx $ Case exp [(pat, ctx $ Var x)]) ]

    PRecord fs -> do
        a <- (\x -> '_' : show x) `liftM` guid
        let toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)
        return (FnDef a [] exp : map toDef fs)

    PAnything -> return []<commit_msg>Fix nested pattern matching in let expressions.<commit_after>
module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) where

import Ast
import Context
import Control.Applicative ((<$>),(<*>))
import Control.Monad
import Control.Monad.State
import Data.Char (isUpper)
import Guid
import Text.Parsec hiding (newline,spaces,State)
import Text.Parsec.Indent
import Parse.Library

patternBasic :: IParser Pattern
patternBasic =
    choice [ char '_' >> return PAnything
           , do x@(c:_) <- var
                return $ if isUpper c then PData x [] else PVar x
           ]

patternRecord :: IParser Pattern
patternRecord = PRecord <$> brackets (commaSep1 lowVar)

patternTuple :: IParser Pattern
patternTuple = do ps <- parens (commaSep patternExpr)
                  return $ case ps of { [p] -> p; _ -> ptuple ps }

patternList :: IParser Pattern
patternList = plist <$> braces (commaSep patternExpr)

patternTerm :: IParser Pattern
patternTerm = choice [ patternRecord, patternTuple, patternList, patternBasic ]
           <?> "pattern"

patternConstructor :: IParser Pattern
patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

patternExpr :: IParser Pattern
patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern"

makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr
makeLambda pats body = go (reverse pats) body
    where go [] body = return body
          go (p:ps) body@(C t s _) = do
            (x,e) <- extract p body
            go ps (C t s $ Lambda x e)
          
extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)
extract pattern body@(C t s _) =
  let ctx = C t s in
  let fn x e = (x,e) in
  case pattern of
    PAnything -> return $ fn "_" body
    PVar x -> return $ fn x body
    PData name ps -> do
        x <- guid
        let a = '_' : show x
        return . fn a . ctx $ Case (ctx (Var a)) [(pattern, body)]
    PRecord fs -> do
        x <- guid
        let a = '_' : show x
            toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)
        return . fn a . ctx $ Let (map toDef fs) body

extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)
extracts ps body = go [] (reverse ps) body
    where go args [] body = return (args, body)
          go args (p:ps) body = do (x,e) <- extract p body
                                   go (x:args) ps e

flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])
flattenPatterns patterns exp@(C t s _) =
  let ctx = C t s in
  case patterns of
    PVar f : args -> do
        (as,e) <- extracts args exp
        return . return $
               if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]
                                else [ FnDef f as e ]

    [p] -> return `liftM` matchSingle p exp p

    _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++
                ") cannot be used on the left-hand side of an assign statement."

matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]
matchSingle pat exp@(C t s _) p =
  let ctx = C t s in
  case p of
    PData _ ps -> do x <- guid
                     let v = '_' : show x
                     dss <- mapM (matchSingle pat . ctx $ Var v) ps
                     return (FnDef v [] exp : concat dss)

    PVar x ->
        return [ FnDef x [] (ctx $ Case exp [(pat, ctx $ Var x)]) ]

    PRecord fs -> do
        a <- (\x -> '_' : show x) `liftM` guid
        let toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)
        return (FnDef a [] exp : map toDef fs)

    PAnything -> return []
{'fraction_non_alphanumeric': 0.1137648388920294, 'fraction_numerical': 0.0008479366873940079, 'mean_word_length': 2.1792452830188678, 'pattern_counts': {'":': 0, '<': 43, '<?xml version=': 0, '>': 77, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6406925', 'n_tokens_mistral': 2229, 'n_tokens_neox': 2146, 'n_words': 856}