<commit_before>module Domain.Programming.Parser where

import Common.Parsing
import Domain.Programming.Expr
import Domain.Programming.Prelude
import Domain.Programming.Eval
import UU.Scanner (pVarsym)
import Data.Char

-----------------------------------------------------------
--- Scanner

scannerExpr :: Scanner
scannerExpr = defaultScanner
   { keywords         = [ "case", "of"
                        , "if", "then", "else"
                        , "let", "in"
                        ] 
   , keywordOperators = ["->", "\\", "="]
   }

-----------------------------------------------------------
--- Parser

parseExpr :: String -> Either SyntaxError Expr
parseExpr = f . parse pExpr . scanWith scannerExpr
 where 
   f (e, []) = Right e
   f (_, xs) = Left $ ErrorMessage $ unlines $ map show xs
   
pExpr :: TokenParser Expr
pExpr = pLambda <|> pOps

pLambda :: TokenParser Expr
pLambda = lambda <$ pKey "\\" <*> pVarid <* pKey "->" <*> pExpr
  where 
    lambda x e = Lambda (fst x) e

pOps :: TokenParser Expr 
pOps = flip ($) <$> pApply <*> optional ((\op r l -> Apply (Apply (Var op) l) r) <$> pVarsym <*> pApply) id

pApply :: TokenParser Expr
pApply = app <$> pList1 pAtom
 where 
   app ats = case ats of 
                  [at] -> at
                  _    -> foldl1 Apply ats

pAtom :: TokenParser Expr
pAtom  =  (Var . fst) <$> (pVarid <|> pConid)
      <|> (\(f,_) e body -> Apply (Lambda f body) (Fix $ Lambda f e))  -- Fix
              <$ pKey "let" <*> pVarid
              <* pKey "="   <*> pExpr
              <* pKey "in"  <*> pExpr 
      <|> (Int . fromInteger) <$> pInteger       -- Int
      <|> pSpec '(' *> pExpr <* pSpec ')'        -- parentheses
      <|> IfThenElse <$ pKey "if"   <*> pExpr    -- If
                     <* pKey "then" <*> pExpr 
                     <* pKey "else" <*> pExpr
      <|> MatchList <$  pKey "case" <*> pExpr    -- case
                    <*  pKey "of"   
                             <*> pExpr              -- nil
                             <*  pSpec ';' <*> pExpr -- cons

-----------------------------------------------------------
--- Pretty-Printer

pprintExpr :: (Expr, Int) -> String
pprintExpr (expr, offset) = 
   case expr of
      Lambda x e -> "\\" ++ x ++ " -> " ++ pprintExpr (e,offset+(length x)+5)
      Var x -> x
      Apply (Lambda f body) (Fix (Lambda _ e)) -> "let " ++ f ++ " = " ++ pprintExpr (e,offset+(length f)+7)
                                                  ++ "\n" ++ spaces offset ++ "in " ++ pprintExpr (body, offset)
      Apply f a -> "(" ++ case f of
                        (Apply (Var op) l) -> if not (isAlpha (head op)) then 
                                                  pprintExpr (l,offset) ++ " " ++ op ++ " " ++ pprintExpr (a,offset)
                                              else
                                                  op ++ " " ++ pprintExpr (l,offset) ++ " " ++ pprintExpr (a,offset)
                        _ -> pprintExpr (f,offset) ++ case a of
                                               (Var _)   -> " "  ++ pprintExpr (a,offset)
                                               (Int _)   -> " "  ++ pprintExpr (a,offset)
                                               _         -> " (" ++ pprintExpr (a,offset) ++ ")"
                   ++ ")"
      Fix f -> case f of 
                 (Lambda x e) -> "let " ++ x ++ " = " ++ pprintExpr (e,offset+(length x)+7) ++ "\n"
                                 ++ spaces offset ++ "in " ++ x
                 _ -> error "Must be a function"
      Int n -> [intToDigit n]
      IfThenElse c t e -> "if " ++ pprintExpr (c,offset) ++ " then\n"
                                ++ spaces (offset+2) ++ pprintExpr (t,offset+2) ++ "\n"
                                ++ spaces offset ++ "else\n"
                                ++ spaces (offset+2) ++ pprintExpr (e,offset+2)
      MatchList b n c -> "case " ++ pprintExpr (b,offset) ++ " of\n" 
                                 ++ spaces (offset+5) ++ pprintExpr (n,offset+5) ++ ";\n"
                                 ++ spaces (offset+5) ++ pprintExpr (c,offset+5)
     where 
      spaces n = take n (Prelude.repeat ' ')


prettyIsort = putStr (pprintExpr (isortE,0) ++ "\n") 

testje = eval (isPermE # mylist # (isort # mylist))
  where
    isort = (\(Right e) -> e) $ parseExpr $ pprintExpr (isortE,0)<commit_msg>Pretty print cleanup<commit_after>module Domain.Programming.Parser where

import Common.Parsing
import Domain.Programming.Expr
import Domain.Programming.Prelude
import Domain.Programming.Eval
import UU.Scanner (pVarsym)
import Data.Char

-----------------------------------------------------------
--- Scanner

scannerExpr :: Scanner
scannerExpr = defaultScanner
   { keywords         = [ "case", "of"
                        , "if", "then", "else"
                        , "let", "in"
                        ] 
   , keywordOperators = ["->", "\\", "="]
   }

-----------------------------------------------------------
--- Parser

parseExpr :: String -> Either SyntaxError Expr
parseExpr = f . parse pExpr . scanWith scannerExpr
 where 
   f (e, []) = Right e
   f (_, xs) = Left $ ErrorMessage $ unlines $ map show xs
   
pExpr :: TokenParser Expr
pExpr = pLambda <|> pOps

pLambda :: TokenParser Expr
pLambda = lambda <$ pKey "\\" <*> pVarid <* pKey "->" <*> pExpr
  where 
    lambda x e = Lambda (fst x) e

pOps :: TokenParser Expr 
pOps = flip ($) <$> pApply <*> optional ((\op r l -> Apply (Apply (Var op) l) r) <$> pVarsym <*> pApply) id

pApply :: TokenParser Expr
pApply = app <$> pList1 pAtom
 where 
   app ats = case ats of 
                  [at] -> at
                  _    -> foldl1 Apply ats

pAtom :: TokenParser Expr
pAtom  =  (Var . fst) <$> (pVarid <|> pConid)
      <|> (\(f,_) e body -> Apply (Lambda f body) (Fix $ Lambda f e))  -- Fix
              <$ pKey "let" <*> pVarid
              <* pKey "="   <*> pExpr
              <* pKey "in"  <*> pExpr 
      <|> (Int . fromInteger) <$> pInteger       -- Int
      <|> pSpec '(' *> pExpr <* pSpec ')'        -- parentheses
      <|> IfThenElse <$ pKey "if"   <*> pExpr    -- If
                     <* pKey "then" <*> pExpr 
                     <* pKey "else" <*> pExpr
      <|> MatchList <$  pKey "case" <*> pExpr    -- case
                    <*  pKey "of"   
                             <*> pExpr              -- nil
                             <*  pSpec ';' <*> pExpr -- cons

-----------------------------------------------------------
--- Pretty-Printer

ppExpr :: (Expr, Int) -> String
ppExpr (expr, i) = 
   case expr of
      Lambda x e -> 
          "\\" ++ x ++ " -> " ++ ppExpr (e,i+(length x)+5)
      Var x -> 
          x
      Apply f a -> 
          "(" ++ case f of
               (Apply (Var op) l) -> 
                   if not $ isAlpha (head op) then -- infix operator
                       ppExpr (l,i) ++ " " ++ op ++ " " ++ ppExpr (a,i)
                   else
                       op ++ " " ++ ppExpr (l,i) ++ " " ++ ppExpr (a,i)
               _ -> ppExpr (f,i) ++ case a of
                   (Var _)   -> " "  ++ ppExpr (a,i)
                   (Int _)   -> " "  ++ ppExpr (a,i)
                   _         -> " (" ++ ppExpr (a,i) ++ ")"
          ++ ")"
      Fix f -> 
          case f of 
              (Lambda x e) -> "let " ++ x ++ " = " ++ ppExpr (e,i+(length x)+7) ++ "\n"
                               ++ spc i ++ "in " ++ x
              _ -> error "Must be a lambda expression"
      Int n -> 
          [intToDigit n]
      IfThenElse c t e -> 
          "if " ++ ppExpr (c,i) ++ " then\n"
          ++ spc (i+2) ++ ppExpr (t,i+2) ++ "\n"
          ++ spc i ++ "else\n"
          ++ spc (i+2) ++ ppExpr (e,i+2)
      MatchList b n c -> 
          "case " ++ ppExpr (b,i) ++ " of\n" 
          ++ spc (i+5) ++ ppExpr (n,i+5) ++ ";\n"
          ++ spc (i+5) ++ ppExpr (c,i+5)
     where 
      spc n = take n (Prelude.repeat ' ')


prettyIsort = putStr (ppExpr (isortE,0) ++ "\n") 

testje = eval (isPermE # mylist # (isort # mylist))
  where
    isort = (\(Right e) -> e) $ parseExpr $ ppExpr (isortE,0)
{'fraction_non_alphanumeric': 0.20047052996532938, 'fraction_numerical': 0.0035908865775136204, 'mean_word_length': 1.2355383337946304, 'pattern_counts': {'":': 0, '<': 77, '<?xml version=': 0, '>': 104, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 25, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1342863', 'n_tokens_mistral': 2596, 'n_tokens_neox': 2488, 'n_words': 671}