<commit_before>module Parser where
import Text.Parsec
import Text.Parsec.String
import Control.Applicative hiding ((<|>), many)
import AST

spaces1 :: Parser ()
spaces1 = space *> spaces

parseNum :: Parser Int
parseNum = read <$> (negInt <|> posInt)
  where negInt = (:) <$> char '-' <*> many1 digit
        posInt = many1 digit

parseIdent :: Parser String
parseIdent = do
  ident <- (:) <$> letter <*> many (alphaNum <|> oneOf "-*&^%$#_?=!")
  if ident `elem` ["lambda", "if", "set!"]
    then fail $ "Reserved word " ++ ident ++ " is improperly used as identifier"
    else return ident

parseSym :: Parser String
parseSym = char '\'' >> (:) <$> letter <*> many (alphaNum <|> oneOf "-*&^%$#_?=!")

parseLit :: Parser (SExp UserPrim)
parseLit = Lit <$> (fmap SSym parseIdent <|> fmap SInt parseNum)

parseLam :: Parser (SExp UserPrim)
parseLam = do
  char '(' *> spaces
  _ <- string "lambda"
  spaces
  vars <- char '(' *> spaces *>
          fmap SVar parseIdent `sepEndBy` spaces1
          <* char ')'
  spaces
  exps <- many1 parseSExp
  spaces *> char ')' 
  return $ Lam vars exps

parseSet :: Parser (SExp UserPrim)
parseSet = do
  char '(' *> spaces
  string "set!"
  var <- SVar <$> parseIdent <* spaces1
  exp <- parseSExp
  spaces *> char ')'
  return $ Set var exp

parseIf :: Parser (SExp UserPrim)
parseIf = do
  char '(' *> spaces
  string "if" *> spaces1
  test  <- parseSExp <* spaces
  true  <- parseSExp <* spaces
  false <- parseSExp <* spaces
  spaces <* char ')'
  return $ If test true false

parseApp :: Parser (SExp UserPrim)
parseApp = do
  fun <- parseSExp
  spaces1
  exps <- parseSExp `sepBy` spaces
  return $ App fun exps

parseVar :: Parser (SExp UserPrim)
parseVar = Var . SVar <$> parseIdent

parseSExp :: Parser (SExp UserPrim)
parseSExp = parseLit
            <|> parseLam
            <|> parseSet
            <|> parseIf
            <|> parseApp
            <|> parseVar

parseSDec :: Parser (SDec UserPrim)
parseSDec = do
  spaces *> char '(' *> spaces
  string "define" *> spaces
  var <- SVar <$> parseIdent <* spaces1
  exp <- parseSExp
  spaces *> char ')'
  return $ Def var exp<commit_msg>Added function to parse a scheme file<commit_after>module Parser where
import Text.Parsec
import Text.Parsec.String
import Control.Applicative hiding ((<|>), many)
import AST

spaces1 :: Parser ()
spaces1 = space *> spaces

parseNum :: Parser Int
parseNum = read <$> (negInt <|> posInt)
  where negInt = (:) <$> char '-' <*> many1 digit
        posInt = many1 digit

parseIdent :: Parser String
parseIdent = do
  ident <- (:) <$> letter <*> many (alphaNum <|> oneOf "-*&^%$#_?=!")
  if ident `elem` ["lambda", "if", "set!"]
    then fail $ "Reserved word " ++ ident ++ " is improperly used as identifier"
    else return ident

parseSym :: Parser String
parseSym = char '\'' >> (:) <$> letter <*> many (alphaNum <|> oneOf "-*&^%$#_?=!")

parseLit :: Parser (SExp UserPrim)
parseLit = Lit <$> (fmap SSym parseIdent <|> fmap SInt parseNum)

parseLam :: Parser (SExp UserPrim)
parseLam = do
  char '(' *> spaces
  _ <- string "lambda"
  spaces
  vars <- char '(' *> spaces *>
          fmap SVar parseIdent `sepEndBy` spaces1
          <* char ')'
  spaces
  exps <- many1 parseSExp
  spaces *> char ')' 
  return $ Lam vars exps

parseSet :: Parser (SExp UserPrim)
parseSet = do
  char '(' *> spaces
  string "set!"
  var <- SVar <$> parseIdent <* spaces1
  exp <- parseSExp
  spaces *> char ')'
  return $ Set var exp

parseIf :: Parser (SExp UserPrim)
parseIf = do
  char '(' *> spaces
  string "if" *> spaces1
  test  <- parseSExp <* spaces
  true  <- parseSExp <* spaces
  false <- parseSExp <* spaces
  spaces <* char ')'
  return $ If test true false

parseApp :: Parser (SExp UserPrim)
parseApp = do
  fun <- parseSExp
  spaces1
  exps <- parseSExp `sepBy` spaces
  return $ App fun exps

parseVar :: Parser (SExp UserPrim)
parseVar = Var . SVar <$> parseIdent

parseSExp :: Parser (SExp UserPrim)
parseSExp = parseLit
            <|> parseLam
            <|> parseSet
            <|> parseIf
            <|> parseApp
            <|> parseVar

parseSDec :: Parser (SDec UserPrim)
parseSDec = do
  spaces *> char '(' *> spaces
  string "define" *> spaces
  var <- SVar <$> parseIdent <* spaces1
  exp <- parseSExp
  spaces *> char ')'
  return $ Def var exp


parseFile :: String -> IO (Either ParseError [SDec UserPrim])
parseFile = parseFromFile (many1 parseSDec)
{'fraction_non_alphanumeric': 0.14684521107580573, 'fraction_numerical': 0.004766227871084884, 'mean_word_length': 3.043119266055046, 'pattern_counts': {'":': 0, '<': 85, '<?xml version=': 0, '>': 76, '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': '2586307', 'n_tokens_mistral': 1587, 'n_tokens_neox': 1510, 'n_words': 460}