<commit_before>-- post process source after initial parsing
module FrontEnd.Lex.Post(
    checkContext,
    checkDataHeader,
    checkPattern,
    checkPatterns,
    checkSconType,
    checkValDef,
    doForeign,
    qualTypeToClassHead,
    checkBangType,
    implicitName,
    mkRecConstrOrUpdate,
    fixupHsDecls
) where

import C.FFI
import Util.Std
import Data.Char
import FrontEnd.HsSyn
import FrontEnd.Lex.ParseMonad
import FrontEnd.SrcLoc
import Name.Names
import Options
import PackedString
import qualified Data.Set as Set
import qualified Data.Traversable as T
import qualified FlagOpts as FO
import qualified FrontEnd.Lex.Fixity as F

checkContext :: HsType -> P HsContext
checkContext (HsTyTuple []) = return []
checkContext (HsTyTuple ts) = mapM checkAssertion ts
checkContext t = (:[]) <$> checkAssertion t

data Scon = SconApp Scon [Scon] | SconType Bool HsType | SconOp Name
    deriving(Show)
checkSconType  :: [Either Name HsType] -> P (Name, [HsBangType])
checkSconType xs = do
    let f (SconOp n) = return n
        f (SconType False (HsTyCon c)) = return c
        f (SconType False (HsTyTuple [])) = return $ quoteName tc_Unit
        f (SconType False _) = parseErrorK "Needs constructor as head."
        f ~(SconType True _) = parseErrorK "Only fields may be made strict."
    let g (SconType False t) = HsUnBangedTy t
--        f (SconApp (SconOp x) [ta,tb]) | x == tc_Arrow = do HsTyFun <$> f tb <*> f ta
        g ~(SconType True t) = HsBangedTy t
    s <- checkSconType' xs
    case s of
        SconApp t ts -> do t <- f t; return (nameTyLevel_s termLevel t, reverse $ map g ts)
        _ -> do s <- f s; return (nameTyLevel_s termLevel s,[])

checkBangType  :: [Either Name HsType] -> P HsBangType
checkBangType xs = checkSconType' xs >>= \s -> case s of
        SconType True ty -> return $ HsBangedTy ty
        _ -> HsUnBangedTy <$> f s
    where
    f (SconType False ty) = return ty
    f (SconApp (SconOp x) [ta,tb]) | x == tc_Arrow = do HsTyFun <$> f tb <*> f ta
    f (SconType True _) = parseErrorK "(!) annotation in wrong place."
    f SconOp {} =  parseErrorK "unexpected operator in type signature."
    f (SconApp t ts) = do foldl HsTyApp <$> f t <*> mapM f (reverse ts)<commit_msg>fix parsing of infix constructors<commit_after>-- post process source after initial parsing
module FrontEnd.Lex.Post(
    checkContext,
    checkDataHeader,
    checkPattern,
    checkPatterns,
    checkSconType,
    checkValDef,
    doForeign,
    qualTypeToClassHead,
    checkBangType,
    implicitName,
    mkRecConstrOrUpdate,
    fixupHsDecls
) where

import C.FFI
import Util.Std
import Data.Char
import FrontEnd.HsSyn
import FrontEnd.Lex.ParseMonad
import FrontEnd.SrcLoc
import Name.Names
import Options
import PackedString
import qualified Data.Set as Set
import qualified Data.Traversable as T
import qualified FlagOpts as FO
import qualified FrontEnd.Lex.Fixity as F

checkContext :: HsType -> P HsContext
checkContext (HsTyTuple []) = return []
checkContext (HsTyTuple ts) = mapM checkAssertion ts
checkContext t = (:[]) <$> checkAssertion t

data Scon = SconApp Scon [Scon] | SconType Bool HsType | SconOp Name
    deriving(Show)
checkSconType  :: [Either Name HsType] -> P (Name, [HsBangType])
checkSconType xs = do
    let f (SconOp n) = return n
        f (SconType False (HsTyCon c)) = return c
        f (SconType False (HsTyTuple [])) = return $ quoteName tc_Unit
        f (SconType False _) = parseErrorK "Needs constructor as head."
        f ~(SconType True _) = parseErrorK "Only fields may be made strict."
--        f (SconApp (SconOp x) [ta,tb]) | x == tc_Arrow = do HsTyFun <$> f tb <*> f ta
    let g (SconType True t) = return $ HsBangedTy t
        g s = HsUnBangedTy <$> h s
        h (SconType False t) = return t
        h (SconApp (SconOp x) [ta,tb]) | x == tc_Arrow = do HsTyFun <$> h tb <*> h ta
        h (SconApp t ts) = do foldl HsTyApp <$> h t <*> mapM h (reverse ts)
        h (SconType True _) = parseErrorK "(!) annotation in wrong place."
        h SconOp {} =  parseErrorK "unexpected operator in type signature."
    s <- checkSconType' xs
    case s of
        SconApp t ts -> do t <- f t; ts <- mapM g ts; return (nameTyLevel_s termLevel t, reverse ts)
        _ -> do s <- f s; return (nameTyLevel_s termLevel s,[])

checkBangType  :: [Either Name HsType] -> P HsBangType
checkBangType xs = checkSconType' xs >>= \s -> case s of
        SconType True ty -> return $ HsBangedTy ty
        _ -> HsUnBangedTy <$> f s
    where
    f (SconType False ty) = return ty
    f (SconApp (SconOp x) [ta,tb]) | x == tc_Arrow = do HsTyFun <$> f tb <*> f ta
    f (SconType True _) = parseErrorK "(!) annotation in wrong place."
    f SconOp {} =  parseErrorK "unexpected operator in type signature."
    f (SconApp t ts) = do foldl HsTyApp <$> f t <*> mapM f (reverse ts)
{'fraction_non_alphanumeric': 0.10064062822897293, 'fraction_numerical': 0.0, 'mean_word_length': 3.063811922753988, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 44, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3186390', 'n_tokens_mistral': 1709, 'n_tokens_neox': 1671, 'n_words': 579}