Going a step further in «optimization» (slowing it even more…) by replacing choice by a search in a Map
This commit is contained in:
parent
afbbcbffc5
commit
cefb08ee50
1 changed files with 60 additions and 18 deletions
|
@ -14,8 +14,8 @@ import Data.Attoparsec.ByteString.Char8 (choice, sepBy)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Data.ByteString as BS (drop, null, take)
|
import qualified Data.ByteString as BS (drop, null, take)
|
||||||
import Data.ByteString.Char8 (pack, unpack)
|
import Data.ByteString.Char8 (pack, unpack)
|
||||||
import Data.Map ((!))
|
import Data.Map ((!), (!?), Map)
|
||||||
import qualified Data.Map as Map (lookup, toList)
|
import qualified Data.Map as Map (fromList, lookup, toList)
|
||||||
import PDF.CMap (CMappers, CMap, CRange(..), emptyCMap)
|
import PDF.CMap (CMappers, CMap, CRange(..), emptyCMap)
|
||||||
import PDF.Object (
|
import PDF.Object (
|
||||||
DirectObject(..), StringObject(..)
|
DirectObject(..), StringObject(..)
|
||||||
|
@ -62,7 +62,20 @@ instance Show TextOperator where
|
||||||
show Tr = "Tr"
|
show Tr = "Tr"
|
||||||
show Ts = "Ts"
|
show Ts = "Ts"
|
||||||
|
|
||||||
stateOperator :: TypeChecker StateOperator
|
stateOperator :: OperatorTable StateOperator
|
||||||
|
stateOperator = Map.fromList [
|
||||||
|
("cm", (Cm, \l -> case l of [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _] -> True ; _ -> False))
|
||||||
|
, ("w", (W, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("J", (J, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("j", (J_, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("M", (M, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("d", (D, \l -> case l of [Raw _, Raw _] -> True ; _ -> False))
|
||||||
|
, ("ri", (Ri, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("i", (I, \l -> case l of [Raw _] -> True ; _ -> False))
|
||||||
|
, ("gs", (Gs, \l -> case l of [Typed (NameObject _)] -> True ; _ -> False))
|
||||||
|
]
|
||||||
|
|
||||||
|
{-
|
||||||
stateOperator (Cm, [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _]) = True
|
stateOperator (Cm, [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _]) = True
|
||||||
stateOperator (W, [Raw _]) = True
|
stateOperator (W, [Raw _]) = True
|
||||||
stateOperator (J, [Raw _]) = True
|
stateOperator (J, [Raw _]) = True
|
||||||
|
@ -73,8 +86,28 @@ stateOperator (Ri, [Raw _]) = True
|
||||||
stateOperator (I, [Raw _]) = True
|
stateOperator (I, [Raw _]) = True
|
||||||
stateOperator (Gs, [Typed (NameObject _)]) = True
|
stateOperator (Gs, [Typed (NameObject _)]) = True
|
||||||
stateOperator _ = False
|
stateOperator _ = False
|
||||||
|
-}
|
||||||
|
|
||||||
textOperator :: TypeChecker TextOperator
|
textOperator :: OperatorTable TextOperator
|
||||||
|
textOperator = Map.fromList $ (\(op, checker) -> (pack $ show op, (op, checker))) <$> [
|
||||||
|
(Td, \l -> case l of [Raw _, Raw _] -> True ; _ -> False)
|
||||||
|
, (TD, \l -> case l of [Raw _, Raw _] -> True ; _ -> False)
|
||||||
|
, (Tm, \l -> case l of [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _] -> True ; _ -> False)
|
||||||
|
, (Tstar, \l -> case l of [] -> True ; _ -> False)
|
||||||
|
, (TJ, \l -> case l of [Typed (Array _)] -> True ; _ -> False)
|
||||||
|
, (Tj, \l -> case l of [Typed (StringObject _)] -> True ; _ -> False)
|
||||||
|
, (Quote, \l -> case l of [Typed (StringObject _)] -> True ; _ -> False)
|
||||||
|
, (DQuote, \l -> case l of [Typed (StringObject _)] -> True ; _ -> False)
|
||||||
|
, (Tc, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
, (Tw, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
, (Tz, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
, (TL, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
, (Tf, \l -> case l of [Typed (NameObject _), Raw _] -> True ; _ -> False)
|
||||||
|
, (Tr, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
, (Ts, \l -> case l of [Raw _] -> True ; _ -> False)
|
||||||
|
]
|
||||||
|
|
||||||
|
{-
|
||||||
textOperator (Td, [Raw _, Raw _]) = True
|
textOperator (Td, [Raw _, Raw _]) = True
|
||||||
textOperator (TD, [Raw _, Raw _]) = True
|
textOperator (TD, [Raw _, Raw _]) = True
|
||||||
textOperator (Tm, [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _]) = True
|
textOperator (Tm, [Raw _, Raw _, Raw _, Raw _, Raw _, Raw _]) = True
|
||||||
|
@ -91,30 +124,39 @@ textOperator (Tf, [Typed (NameObject _), Raw _]) = True
|
||||||
textOperator (Tr, [Raw _]) = True
|
textOperator (Tr, [Raw _]) = True
|
||||||
textOperator (Ts, [Raw _]) = True
|
textOperator (Ts, [Raw _]) = True
|
||||||
textOperator _ = False
|
textOperator _ = False
|
||||||
|
-}
|
||||||
|
|
||||||
type ArgumentStackParser m = (MonadState [Argument] m, MonadParser m)
|
type ArgumentStackParser m = (MonadState [Argument] m, MonadParser m)
|
||||||
type Operator a = (Bounded a, Enum a, Show a)
|
type Operator a = (Bounded a, Enum a, Show a)
|
||||||
type TypeChecker a = Call a -> Bool
|
type OperatorTable a = Map ByteString (TypeChecker a)
|
||||||
|
type TypeChecker a = (a, [Argument] -> Bool)
|
||||||
|
|
||||||
parseShowable :: (Show a, MonadParser m) => a -> m a
|
parseShowable :: (Show a, MonadParser m) => a -> m a
|
||||||
parseShowable textOp = string (pack $ show textOp) *> return textOp
|
parseShowable textOp = string (pack $ show textOp) *> return textOp
|
||||||
|
|
||||||
callChunk :: (MonadParser m, Operator a) => m (Either a Argument)
|
callChunk :: MonadParser m => OperatorTable a -> m (Either (TypeChecker a) Argument)
|
||||||
callChunk =
|
callChunk table =
|
||||||
Left <$> choice (parseShowable <$> [minBound .. maxBound])
|
(Right <$> choice [stringArg, nameArg, arrayArg])
|
||||||
<|> Right <$> choice [stringArg, nameArg, arrayArg, argument]
|
<|> operatorOrRawArg
|
||||||
<?> "call chunk"
|
<?> "call chunk"
|
||||||
|
|
||||||
stackParser :: (ArgumentStackParser m, Operator a) => TypeChecker a -> m (Call a)
|
|
||||||
stackParser typeChecker = either popCall push =<< callChunk
|
|
||||||
where
|
where
|
||||||
push arg = modify (arg:) >> stackParser typeChecker
|
operatorOrRawArg = do
|
||||||
popCall operator = do
|
chunk <- takeAll1 regular <* blank
|
||||||
call <- (,) operator . reverse <$> get
|
case table !? chunk of
|
||||||
if typeChecker call then return call else fail (show call)
|
Nothing -> return . Right $ Raw chunk
|
||||||
|
Just typeChecker -> return $ Left typeChecker
|
||||||
|
|
||||||
a :: (Operator a, MonadParser m) => TypeChecker a -> m (Call a)
|
stackParser :: (ArgumentStackParser m, Show a) => OperatorTable a -> m (Call a)
|
||||||
a typeChecker = evalStateT (stackParser typeChecker) []
|
stackParser table = either popCall push =<< (callChunk table)
|
||||||
|
where
|
||||||
|
push arg = modify (arg:) >> stackParser table
|
||||||
|
popCall (operator, predicate) = do
|
||||||
|
arguments <- reverse <$> get
|
||||||
|
let call = (operator, arguments)
|
||||||
|
if predicate arguments then return call else fail (show call)
|
||||||
|
|
||||||
|
a :: (Operator a, MonadParser m) => OperatorTable a -> m (Call a)
|
||||||
|
a table = evalStateT (stackParser table) []
|
||||||
|
|
||||||
argument :: MonadParser m => m Argument
|
argument :: MonadParser m => m Argument
|
||||||
argument = Raw <$> takeAll1 regular <* blank
|
argument = Raw <$> takeAll1 regular <* blank
|
||||||
|
|
Loading…
Reference in a new issue