Re: [DOMjudge-commits] Checktestdata branch master updated.

Yes, it's a proof of concept so docs are still a todo ;-) In short, install Haskell platform and then (in the haskell_edsl dir), do:

cabal install --only-dependencies cabal configure cabal build

This installs the required dependencies, and then creates an executable in dist/build/checktestdata/checktestdata. Alternatively you may just do 'cabal install' but this installs the checktestdata executable globally, which may conflict with other executables of that name in your path.

Jeroen

Op 1-1-2017 om 15:14 schreef Jaap Eldering:

Hi Jeroen,

Could you add a description or Makefile documenting how to build this? I tried to do so by installing cabal, and the required packages, but failed. I think I didn't have exactly the right versions, and even then, the Setup binary complained that none of the packages were available.

Jaap

On 01-01-17 10:42, DOMjudge wrote:

...

The branch, master has been updated from c525f8b20c1d59e54db2b6399fb5dab9475bb903 (commit) via c6bcd2e71281bf990b0ca9f6254236622d4ebc97 (commit) via d7fea2aabc5ad165ce93589d47398cc99a3f0765 (commit)

• Log -----------------------------------------------------------------

---

https://www.domjudge.org/gitweb/?p=checktestdata.git;a=commitdiff;h=c6bcd2e7 commit c6bcd2e71281bf990b0ca9f6254236622d4ebc97 Author: Jeroen Bransen jeroen@chordify.net Date: Sun Jan 1 13:38:25 2017 +0100

 [haskell_edsl] Add regex support

diff --git a/haskell_edsl/checktestdata.cabal b/haskell_edsl/checktestdata.cabal index 42babc6..9e42a30 100644 --- a/haskell_edsl/checktestdata.cabal +++ b/haskell_edsl/checktestdata.cabal @@ -27,6 +27,7 @@ library containers >=0.5 && <0.6, either >=4.3 && <4.5, mtl >=2.2 && <2.3,

•                   regex-tdfa >= 1.2,
                     uu-parsinglib >= 2.9
  

  hs-source-dirs: src default-language: Haskell2010

diff --git a/haskell_edsl/src/Checktestdata/Core.hs b/haskell_edsl/src/Checktestdata/Core.hs index e3242b3..11615dc 100644 --- a/haskell_edsl/src/Checktestdata/Core.hs +++ b/haskell_edsl/src/Checktestdata/Core.hs @@ -12,6 +12,7 @@ module Checktestdata.Core ( nextHex, nextFloat, string,

• regex, eof, isEOF, ) where

@@ -21,6 +22,9 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lex.Fractional as FR import qualified Data.ByteString.Lex.Integral as INT

+import Text.Regex.TDFA +import Text.Regex.TDFA.ByteString

• import Control.Monad.State import Control.Monad.Trans.Either

@@ -172,6 +176,24 @@ string s = PrimOp $ do True -> do putRemaining $ BS.drop (length s) cs

+-- | Match with the given regular expression +regex :: String -> CTD String +regex rs = PrimOp $ do

• let reg = compile defaultCompOpt defaultExecOpt $ BS.pack rs
• case reg of
• Left e -> failWithLocation e
• Right r -> do

•  cs <- getRemaining
  

•  let err = "Expression " ++ show rs ++ " does not match"
  

•  case regexec r cs of
  

•    Right (Just (pre,main,post,_)) -> case BS.null pre of
  

•      True  -> do
  

•        putRemaining post
  

•        return $ BS.unpack main
  

•      False -> failWithLocation err
  

•    Left e  -> failWithLocation e
  

•    Right _ -> failWithLocation err
  

• -- | Check whether we are at the end of the file. isEOF :: CTD Bool isEOF = PrimOp $ do

---

https://www.domjudge.org/gitweb/?p=checktestdata.git;a=commitdiff;h=d7fea2aa commit d7fea2aabc5ad165ce93589d47398cc99a3f0765 Author: Jeroen Bransen jeroen@chordify.net Date: Sun Jan 1 13:40:02 2017 +0100

 [haskell_edsl] Almost complete backwards compatibility, passes most tests

diff --git a/haskell_edsl/src/Checktestdata/Script/AST.hs b/haskell_edsl/src/Checktestdata/Script/AST.hs index f116515..7542c24 100644 --- a/haskell_edsl/src/Checktestdata/Script/AST.hs +++ b/haskell_edsl/src/Checktestdata/Script/AST.hs @@ -1,5 +1,6 @@ module Checktestdata.Script.AST (

• Var,

• VarName,
• Var (..), Block, AST (..), Expr (..),

@@ -8,9 +9,11 @@ module Checktestdata.Script.AST ( Test (..), CompOp (..), ) where --- data Var = Var String [Expr]

-type Var = String +type VarName = String

+data Var = Var VarName [Expr]

•     deriving ( Show )
  
  

  type Block = [AST]

@@ -20,11 +23,12 @@ data AST = CSpace | CInt Expr Expr (Maybe Var) | CFloat Expr Expr (Maybe Var) (Maybe FloatOption) | CString Expr

•     | CRegex Expr (Maybe Var)
       | CRep (Maybe Var) Expr (Maybe AST) Block -- var, count, separator, body
       | CWhile (Maybe Var) Test (Maybe AST) Block
       | CAssert Test
       | CSet [(Var, Expr)]
  

•     | CUnset [Var]
  

•     | CUnset [VarName]
       | CIf Test Block (Maybe Block)
       deriving (Show)
  
  

@@ -54,8 +58,8 @@ data Test = Not Test | And Test Test | Or Test Test | Match Expr

•      | Unique [Var]
  

•      | InArray Expr Var
  

•      | Unique [VarName]
  

•      | InArray Expr VarName
        | IsEOF
        deriving (Show)
  
  

diff --git a/haskell_edsl/src/Checktestdata/Script/Interpreter.hs b/haskell_edsl/src/Checktestdata/Script/Interpreter.hs index c74c9a9..8013e09 100644 --- a/haskell_edsl/src/Checktestdata/Script/Interpreter.hs +++ b/haskell_edsl/src/Checktestdata/Script/Interpreter.hs @@ -8,6 +8,7 @@ import Checktestdata.Core import Checktestdata.Derived import Checktestdata.Script.AST

+import Data.List ( genericLength, transpose ) import Data.Map ( Map ) import qualified Data.Map as Map

@@ -19,26 +20,32 @@ import Control.Monad.State

-- todo: error handling on script parsing level --- todo: arrays

data Value = VInt Integer | VFloat Rational | VString String

•       deriving ( Show, Eq, Ord )
  
  

-type ValueMap = Map Var Value +type ValueMap = Map VarName (Map [Value] Value)

setValue :: Maybe Var -> Value -> InterpretMonad () setValue Nothing _ = return () -setValue (Just var) val = modify $ Map.insert var val +setValue (Just (Var var eidxs)) val = do

• idxs <- mapM fExpr eidxs

• modify $ Map.insertWith Map.union var $ Map.singleton idxs val

  getValue :: Var -> InterpretMonad Value

-getValue var = do +getValue (Var var eidxs) = do vm <- get case Map.lookup var vm of

• Nothing -> error $ "Undefined variable " ++ var
• Just val -> return val

-unsetVar :: Var -> InterpretMonad ()

• Nothing -> error $ "Undefined variable " ++ show var
• Just vmi -> do

•  idxs <- mapM fExpr eidxs
  

•  case Map.lookup idxs vmi of
  

•    Nothing  -> error $ "Undefined index " ++ show idxs
  

•    Just val -> return val
  

+unsetVar :: VarName -> InterpretMonad () unsetVar var = modify $ Map.delete var

toInt :: Value -> InterpretMonad Integer @@ -66,133 +73,158 @@ liftC = lift

-- | Interpret an old checktestdata script into an executable 'CTD' interpret :: Block -> CTD () -interpret = flip evalStateT Map.empty . fBlock where +interpret = flip evalStateT Map.empty . fBlock

• -- Code blocks (simple fold)

• fBlock :: Block -> InterpretMonad ()
• fBlock = mapM_ fAST
• -- AST elements
• fAST :: AST -> InterpretMonad ()
• fAST CSpace = liftC space
• fAST CNewline = liftC newline
• fAST CEOF = liftC eof
• fAST (CSet vs) = forM_ vs $ (var,e) -> do
• val <- fExpr e
• setValue (Just var) val
• fAST (CUnset vs) = mapM_ unsetVar vs
• fAST (CInt low up var) = do
• vlow <- fExpr low >>= toInt
• vup <- fExpr up >>= toInt
• val <- liftC $ int vlow vup
• setValue var (VInt val)
• fAST (CFloat low up var _) = do -- todo: scientific/fixed option
• vlow <- fExpr low >>= toFloat
• vup <- fExpr up >>= toFloat
• val <- liftC $ float vlow vup
• setValue var (VFloat val)
• fAST (CString s) = do
• str <- fExpr s >>= toString
• liftC $ string str
• fAST (CAssert test) = do
• b <- fTest test
• liftC $ assert b
• fAST (CRep var count mbSep body) = do
• vcount <- fExpr count >>= toInt
• forM_ [0..vcount-1] $ \i -> do

•  -- Parse separator
  

•  case mbSep of
  

•    Just sep | i > 0 -> fAST sep
  

•    _ -> return ()
  

•  -- Set iterator
  

•  setValue var (VInt i)
  

+fBlock :: Block -> InterpretMonad () +fBlock = mapM_ fAST

+-- AST elements +fAST :: AST -> InterpretMonad () +fAST CSpace = liftC space +fAST CNewline = liftC newline +fAST CEOF = liftC eof +fAST (CSet vs) = forM_ vs $ (var,e) -> do

• val <- fExpr e
• setValue (Just var) val

+fAST (CUnset vs) = mapM_ unsetVar vs +fAST (CInt low up var) = do

• vlow <- fExpr low >>= toInt
• vup <- fExpr up >>= toInt
• val <- liftC $ int vlow vup
• setValue var (VInt val)

+fAST (CFloat low up var _) = do -- todo: scientific/fixed option

• vlow <- fExpr low >>= toFloat
• vup <- fExpr up >>= toFloat
• val <- liftC $ float vlow vup
• setValue var (VFloat val)

+fAST (CString s) = do

• str <- fExpr s >>= toString
• liftC $ string str

+fAST (CRegex sr var) = do

• r <- fExpr sr >>= toString
• val <- liftC $ regex r
• setValue var (VString val)

+fAST (CAssert test) = do

• b <- fTest test
• liftC $ assert b

+fAST (CRep var count mbSep body) = do

• vcount <- fExpr count >>= toInt
• forM_ [0..vcount-1] $ \i -> do
• -- Parse separator
• case mbSep of

•  Just sep | i > 0 -> fAST sep
  

•  _ -> return ()
  
  

•  -- Do the body
  

•  fBlock body
  

• fAST (CWhile var test mbSep body) = do
• let it :: Integer -> InterpretMonad ()

•    it i = do
  

•      setValue var (VInt i)
  

•      b <- fTest test
  

•      when b $ do
  

•        -- Condition true, so parse separator
  

•        case mbSep of
  

•          Just sep | i > 0 -> fAST sep
  

•          _                -> return ()
  

•        -- And parse body
  

•        fBlock body
  

•        -- And repeat
  

•        it $ i + 1
  

• it 0
• fAST (CIf test ifTrue mbIfFalse) = do
• b <- fTest test
• if b then fBlock ifTrue

•     else case mbIfFalse of
  

•            Nothing -> return ()
  

•            Just bl -> fBlock bl
  

• -- Expression evaluation
• fExpr :: Expr -> InterpretMonad Value
• fExpr (EVar var) = getValue var
• fExpr (ConstI v) = return $ VInt v
• fExpr (ConstF v) = return $ VFloat v
• fExpr (ConstS v) = return $ VString v
• fExpr (Negate e) = do
• val <- fExpr e
• case val of

•  VInt v   -> return $ VInt   $ negate v
  

•  VFloat v -> return $ VFloat $ negate v
  

•  _        -> error "Integer of float expected"
  

• fExpr (BinOp op e1 e2) = do
• v1 <- fExpr e1
• v2 <- fExpr e2
• fBinOp op v1 v2
• -- Binary operators
• fBinOp :: BinOp -> Value -> Value -> InterpretMonad Value
• fBinOp Plus v1 v2 = fNumOp (+) v1 v2
• fBinOp Minus v1 v2 = fNumOp (-) v1 v2
• fBinOp Times v1 v2 = fNumOp (*) v1 v2
• fBinOp Div v1 v2 = case (v1, v2) of
• (VInt i1, VInt i2) -> return $ VInt $ i1 `div` i2
• _ -> do

•  f1 <- toFloat v1
  

•  f2 <- toFloat v2
  

•  return $ VFloat $ f1 / f2
  

• fBinOp Modulo v1 v2 = do
• i1 <- toInt v1
• i2 <- toInt v2
• return $ VInt $ i1 `mod` i2
• fBinOp Pow v1 v2 = do
• i2 <- toInt v2
• case v1 of

•  VInt   i1 -> return $ VInt   $ i1 ^ i2
  

•  VFloat f1 -> return $ VFloat $ f1 ^^ i2
  

•  _         -> error "Integer of float expected"
  

• fNumOp :: (forall a. Num a => a -> a -> a) -> Value -> Value -> InterpretMonad Value
• fNumOp op v1 v2 = case (v1, v2) of
• (VInt i1, VInt i2) -> return $ VInt $ i1 `op` i2
• _ -> do

•  f1 <- toFloat v1
  

•  f2 <- toFloat v2
  

•  return $ VFloat $ f1 `op` f2
  

• fTest :: Test -> InterpretMonad Bool
• fTest IsEOF = liftC isEOF
• fTest (Not test) = liftM not (fTest test)
• fTest (And t1 t2) = liftM2 (&&) (fTest t1) (fTest t2)
• fTest (Or t1 t2) = liftM2 (||) (fTest t1) (fTest t2)
• fTest (CompOp cmp e1 e2) = do
• v1 <- fExpr e1 >>= toFloat -- note that Float here is also exact
• v2 <- fExpr e2 >>= toFloat
• let Just op = cmp `lookup` [ (CompGT, (>))

•                           , (CompGE, (>=))
  

•                           , (CompEQ, (==))
  

•                           , (CompNE, (/=))
  

•                           , (CompLT, (<))
  

•                           , (CompLE, (<=)) ]
  

• return $ v1 `op` v2
• fTest (Match e) = do
• s <- fExpr e >>= toString
• liftC $ match s

• -- Set iterator
• setValue var (VInt i)
• -- Do the body
• fBlock body

+fAST (CWhile var test mbSep body) = do

• let it :: Integer -> InterpretMonad ()

•  it i = do
  

•    setValue var (VInt i)
  

•    b <- fTest test
  

•    when b $ do
  

•      -- Condition true, so parse separator
  

•      case mbSep of
  

•        Just sep | i > 0 -> fAST sep
  

•        _                -> return ()
  

•      -- And parse body
  

•      fBlock body
  

•      -- And repeat
  

•      it $ i + 1
  

• it 0

+fAST (CIf test ifTrue mbIfFalse) = do

• b <- fTest test
• if b then fBlock ifTrue

•   else case mbIfFalse of
  

•          Nothing -> return ()
  

•          Just bl -> fBlock bl
  

+-- Expression evaluation +fExpr :: Expr -> InterpretMonad Value +fExpr (EVar var) = getValue var +fExpr (ConstI v) = return $ VInt v +fExpr (ConstF v) = return $ VFloat v +fExpr (ConstS v) = return $ VString v +fExpr (StrLen e) = do

• val <- fExpr e >>= toString
• return $ VInt $ genericLength val

+fExpr (Negate e) = do

• val <- fExpr e
• case val of
• VInt v -> return $ VInt $ negate v
• VFloat v -> return $ VFloat $ negate v
• _ -> error "Integer of float expected"

+fExpr (BinOp op e1 e2) = do

• v1 <- fExpr e1
• v2 <- fExpr e2
• fBinOp op v1 v2

+-- Binary operators +fBinOp :: BinOp -> Value -> Value -> InterpretMonad Value +fBinOp Plus v1 v2 = fNumOp (+) v1 v2 +fBinOp Minus v1 v2 = fNumOp (-) v1 v2 +fBinOp Times v1 v2 = fNumOp (*) v1 v2 +fBinOp Div v1 v2 = case (v1, v2) of

• (VInt i1, VInt i2) -> return $ VInt $ i1 `div` i2
• _ -> do
• f1 <- toFloat v1
• f2 <- toFloat v2
• return $ VFloat $ f1 / f2

+fBinOp Modulo v1 v2 = do

• i1 <- toInt v1
• i2 <- toInt v2
• return $ VInt $ i1 `mod` i2

+fBinOp Pow v1 v2 = do

• i2 <- toInt v2
• case v1 of
• VInt i1 -> return $ VInt $ i1 ^ i2
• VFloat f1 -> return $ VFloat $ f1 ^^ i2
• _ -> error "Integer of float expected"

+fNumOp :: (forall a. Num a => a -> a -> a) -> Value -> Value -> InterpretMonad Value +fNumOp op v1 v2 = case (v1, v2) of

• (VInt i1, VInt i2) -> return $ VInt $ i1 `op` i2
• _ -> do
• f1 <- toFloat v1
• f2 <- toFloat v2
• return $ VFloat $ f1 `op` f2

+fTest :: Test -> InterpretMonad Bool +fTest IsEOF = liftC isEOF +fTest (Not test) = liftM not (fTest test) +fTest (And t1 t2) = liftM2 (&&) (fTest t1) (fTest t2) +fTest (Or t1 t2) = liftM2 (||) (fTest t1) (fTest t2) +fTest (Unique vs) = do

• vm <- get
• keyvals <- forM vs $ \v -> do
• let mp = Map.findWithDefault (error $ "Undefined variable " ++ v) v vm
• let (keys, vals) = unzip $ Map.toList mp
• return (keys, vals)
• let (k:ks, vals) = unzip keyvals
• let pairs = transpose vals
• when (any (/=k) ks) $ liftC $ fail "Different sets of indices"
• return $ unique pairs

+fTest (InArray val var) = do

• vm <- get
• case Map.lookup var vm of
• Nothing -> liftC $ fail $ "Undefined variable " ++ var
• Just vals -> do

•  v <- fExpr val
  

•  return $ v `elem` Map.elems vals
  

+fTest (CompOp cmp e1 e2) = do

• v1 <- fExpr e1 >>= toFloat -- note that Float here is also exact
• v2 <- fExpr e2 >>= toFloat
• let Just op = cmp `lookup` [ (CompGT, (>))

•                         , (CompGE, (>=))
  

•                         , (CompEQ, (==))
  

•                         , (CompNE, (/=))
  

•                         , (CompLT, (<))
  

•                         , (CompLE, (<=)) ]
  

• return $ v1 `op` v2

+fTest (Match e) = do

• s <- fExpr e >>= toString
• liftC $ match s

diff --git a/haskell_edsl/src/Checktestdata/Script/Parser.hs b/haskell_edsl/src/Checktestdata/Script/Parser.hs index 125ce40..5618432 100644 --- a/haskell_edsl/src/Checktestdata/Script/Parser.hs +++ b/haskell_edsl/src/Checktestdata/Script/Parser.hs @@ -6,11 +6,6 @@ module Checktestdata.Script.Parser (

import Checktestdata.Script.AST

---import Text.ParserCombinators.Parsec ---import Text.ParserCombinators.Parsec.Language ---import Text.ParserCombinators.Parsec.Expr ---import qualified Text.ParserCombinators.Parsec.Token as Token

• import Data.Char import Data.Ratio

@@ -25,12 +20,24 @@ import Text.ParserCombinators.UU.Utils parseScript :: FilePath -> IO Block parseScript fp = do contents <- readFile fp

• case execParser (pSpaces *> pBlock) (dropComments contents) of
• (r, []) -> return r
• (r, err) -> mapM_ print err >> return r

• return $ runParser fp (pSpaces *> pBlock) (dropComments contents)

+-- | Remove all comments from the text. This is less trivial than it seems +-- as # may also be inside a string literal. dropComments :: String -> String -dropComments = unlines . map (takeWhile (/='#')) . lines +dropComments = f False False where

• f :: Bool -> Bool -> String -> String -- inComment, inString

• f _ _ "" = ""

• f True False ('\n':xs) = '\n' : f False False xs

• f True False ( _:xs) = f True False xs

• f False True ('\':x:xs) = '\' : x : f False True xs

• f False True ('"' :xs) = '"' : f False False xs

• f False True ( x:xs) = x : f False True xs

• f False False ('"' :xs) = '"' : f False True xs

• f False False ('#' :xs) = f True False xs

• f False False ( x:xs) = x : f False False xs

• f _ _ _ = error "dropComments: invariant failed"

• ---

  -- Parsing

@@ -48,19 +55,19 @@ pAST = CSpace <$ pSymbol "SPACE" <*> pExpr <* pComma <*> pExpr

•             <*> (Just <$ pComma <*> identifier <<|> pure Nothing)
  

•             <*> (Just <$ pComma <*> pVar <<|> pure Nothing)
               <*  pRParen
  

  <<|> CFloat <$ pSymbol "FLOAT" <* pLParen <*> pExpr <* pComma <*> pExpr

•             <*> (Just <$ pComma <*> identifier <<|> pure Nothing)
  

•             <*> (Just <$ pComma <*> pVar <<|> pure Nothing)
               <*> (Just <$ pComma <*> pFloatOption <<|> pure Nothing)
               <*  pRParen
  

  <<|> CRep <$ pSymbol "REPI" <* pLParen

•             <*> (Just <$> identifier <* pComma)
  

•             <*> (Just <$> pVar <* pComma)
               <*> pExpr
               <*> (Just <$ pComma <*> pAST <<|> pure Nothing)
               <*  pRParen
  

@@ -76,7 +83,7 @@ pAST = CSpace <$ pSymbol "SPACE" <* pSymbol "END" <<|> CWhile <$ pSymbol "WHILEI" <* pLParen

•             <*> (Just <$> identifier <* pComma)
  

•             <*> (Just <$> pVar <* pComma)
               <*> pTest
               <*> (Just <$ pComma <*> pAST <<|> pure Nothing)
               <*  pRParen
  

@@ -101,6 +108,11 @@ pAST = CSpace <$ pSymbol "SPACE" <* pLParen <*> pTest <* pRParen

• <<|> CRegex <$ pSymbol "REGEX"

•             <*  pLParen
  

•             <*> pExpr
  

•             <*> (Just <$ pComma <*> pVar <<|> pure Nothing)
  

•             <*  pRParen
  

  <<|> CString <$ pSymbol "STRING" <* pLParen <*> pExpr

@@ -109,11 +121,15 @@ pAST = CSpace <$ pSymbol "SPACE" <* pLParen <*> pListSep pComma (

•                   (,) <$> identifier
  

•                       <*  pSym '='
  

•                   (,) <$> pVar
  

•                       <*  lexeme (pSym '=')
                         <*> pExpr
                   )
               <*  pRParen
  

• <<|> CUnset <$ pSymbol "UNSET"

•             <*  pLParen
  

•             <*> pListSep pComma identifier
  

•             <*  pRParen
  
  

  pFloatOption :: Parser FloatOption pFloatOption = Scientific <$ pSymbol "SCIENTIFIC"

@@ -121,12 +137,16 @@ pFloatOption = Scientific <$ pSymbol "SCIENTIFIC"

pExpr :: Parser Expr pExpr = foldr pChainl pExprBase (map same_prio operators) where

• same_prio ops = msum [ BinOp op <$ pSym c | (c, op) <- ops]

• same_prio ops = msum [ BinOp op <$ lexeme (pSym c) | (c, op) <- ops] pExprBase :: Parser Expr pExprBase = pParens pExpr

• <<|> Negate <$ pSym '-'

• <<|> Negate <$ lexeme (pSym '-') <*> pExpr

• <<|> EVar <$> identifier

• <<|> StrLen <$ pSymbol "STRLEN"

•            <*  pLParen
  

•            <*> pExpr
  

•            <*  pRParen
  

• <<|> EVar <$> pVar <<|> ConstS <$> pString <<|> lexeme pNumber

@@ -151,6 +171,7 @@ pNumber = mkNum mkNum i mbF mbE = ConstF $ (fromInteger i + fpart) * epart where fpart = case mbF of Nothing -> 0

•  Just "" -> 0
    Just f  -> (read f) % (10 ^ length f)
  epart = case mbE of
    Nothing -> 1
  

@@ -158,16 +179,31 @@ pNumber = mkNum

-- | Parse a literal string pString :: Parser String -pString = lexeme $ pSym '"' *> pList pChar <* pSym '"' where

• pChar :: Parser Char -- todo: [0-7]{1,3} denotes an octal escape for a character
• pChar = '\n' <$ pToken "\n"

• <<|> '\t' <$ pToken "\\t"
  

• <<|> '\r' <$ pToken "\\r"
  

• <<|> '\b' <$ pToken "\\b"
  

• <<|> '"'  <$ pToken "\\\""
  

• <<|> '\\' <$ pToken "\\\\"
  

• <<|> pToken "\\\n" *> pSatisfy (/='"') (Insertion "x" 'x' 5)
  

• <<|> pSatisfy (/='"') (Insertion "x" 'x' 5)
  

+pString = lexeme $ pSym '"' *> pList pChar <* pSym '"' where

• pChar :: Parser Char

• pChar = pSym '\' *> ( pOctal

•                <<|> '\n' <$ pSym 'n'
  

•                <<|> '\t' <$ pSym 't'
  

•                <<|> '\r' <$ pSym 'r'
  

•                <<|> '\b' <$ pSym 'b'
  

•                <<|> '\\' <$ pSym '\\'
  

•                <<|> '"'  <$ pSym '"'
  

•                <<|> pSym '\n' *> pChar
  

•                <<|> pure '\\')
  

• <<|> pSatisfy (/='"') (Insertion "x" 'x' 5)

• pOctal :: Parser Char

• pOctal = toOct <$> octDig

•             <*> (Just <$> octDig <<|> pure Nothing)
  

•             <*> (Just <$> octDig <<|> pure Nothing)
  

• toOct :: Char -> Maybe Char -> Maybe Char -> Char

• toOct d1 (Just d2) (Just d3) = chr $ 64 * toNum d1 + 8 * toNum d2 + toNum d3

• toOct d1 (Just d2) Nothing = chr $ 8 * toNum d1 + toNum d2

• toOct d1 Nothing Nothing = chr $ toNum d1

• toOct _ _ _ = error $ "toOct: invariant failed"

• toNum :: Char -> Int

• toNum c = ord c - ord '0'

• octDig :: Parser Char

• octDig = pSatisfy (\c -> '0' <= c && c <= '7') (Insertion "0" '0' 5)

  -- | Parse boolean expressions pTest :: Parser Test

@@ -175,7 +211,7 @@ pTest = pChainl bOps pTestBase where bOps = And <$ pSymbol "&&" <<|> Or <$ pSymbol "||" pTestBase = pParens pTest

•     <<|> Not     <$  pSym '!'
  

•     <<|> Not     <$  lexeme (pSym '!')
                    <*> pTest
       <<|> IsEOF   <$  pSymbol "ISEOF"
       <<|> Match   <$  pSymbol "MATCH"
  

@@ -203,9 +239,14 @@ pTest = pChainl bOps pTestBase where ] ]

+-- | Parse a variable (possibly with array indices) +pVar :: Parser Var +pVar = Var <$> identifier

•       <*> ( pLBracket *> pListSep pComma pExpr <* pRBracket <<|> pure [])
  

• ---

  -- Lexing

  identifier :: Parser String

-identifier = lexeme $ (:) <$> pLetter <*> pMunch isAlphaNum +identifier = lexeme $ (:) <$> pLower <*> pMunch (\c -> isLower c || isDigit c)

---

Summary of changes: haskell_edsl/checktestdata.cabal | 1 + haskell_edsl/src/Checktestdata/Core.hs | 22 ++ haskell_edsl/src/Checktestdata/Script/AST.hs | 16 +- .../src/Checktestdata/Script/Interpreter.hs | 304 ++++++++++++--------- haskell_edsl/src/Checktestdata/Script/Parser.hs | 101 +++++-- 5 files changed, 272 insertions(+), 172 deletions(-)

---

DOMjudge-devel mailing list DOMjudge-devel@domjudge.org https://www.domjudge.org/mailman/listinfo/domjudge-devel