utilisation du tas pour CPS vs parseurs non-CPS dans parsec

Question

Je suis en train d'écrire l'analyseur suivant Haskell utilisant parsec:

manyLength 
    :: forall s u m a. 
    Monad m 
    => ParsecT s u m a -> ParsecT s u m Int 
manyLength p = go 0 
    where 
    go :: Int -> ParsecT s u m Int 
    go !i = (p *> go (i + 1)) <|> pure i 

Cela ressemble à la fonction many, mais au lieu de retourner [a], il retours le nombre de fois que Parser a a abouti.

Cela fonctionne, mais je n'arrive pas à le faire fonctionner dans un espace mémoire constant. Cela rend sens, puisque l'appel récursif à go n'est pas dans la position de queue-appel.

Si parsec exportait le constructeur vers ParsecT, il serait possible de réécrire manyLength sous forme de CPS. Ceci est très similaire à la fonction manyAccum :

manyLengthCPS :: forall s u m a. ParsecT s u m a -> ParsecT s u m Int 
manyLengthCPS p = ParsecT f 
    where 
    f 
     :: forall b. 
     State s u 
     -> (Int -> State s u -> ParseError -> m b) -- consumed ok 
     -> (ParseError -> m b)      -- consumed err 
     -> (Int -> State s u -> ParseError -> m b) -- empty ok 
     -> (ParseError -> m b)      -- empty err 
     -> m b 
    f s cok cerr eok _ = 
     let walk :: Int -> a -> State s u -> ParseError -> m b 
      walk !i _ s' _ = 
      unParser p s' 
       (walk $ i + 1)   -- consumed-ok 
       cerr      -- consumed-err 
       manyLengthCPSErr   -- empty-ok 
       (\e -> cok (i + 1) s' e) -- empty-err 
     in unParser p s (walk 0) cerr manyLengthCPSErr (\e -> eok 0 s e) 
    {-# INLINE f #-} 

manyLengthCPSErr :: Monad m => m a 
manyLengthCPSErr = 
    fail "manyLengthCPS can't be used on parser that accepts empty input" 

Cette fonction manyLengthCPSne course dans l'espace de tas constant.

Voici le constructeur juste pour être complet:

newtype ParsecT s u m a = ParsecT 
    { unParser 
     :: forall b . 
     State s u 
     -> (a -> State s u -> ParseError -> m b) -- consumed ok 
     -> (ParseError -> m b)     -- consumed err 
     -> (a -> State s u -> ParseError -> m b) -- empty ok 
     -> (ParseError -> m b)     -- empty err 
     -> m b 
    } 

J'ai aussi essayé de tourner manyLengthCPS directement dans une fonction non-CPS'ed en utilisant la fonction bas niveau mkPT:

manyLengthLowLevel 
    :: forall s u m a. 
    Monad m 
    => ParsecT s u m a -> ParsecT s u m Int 
manyLengthLowLevel p = mkPT f 
    where 
    f :: State s u -> m (Consumed (m (Reply s u Int))) 
    f parseState = do 
     consumed <- runParsecT p parseState 
     case consumed of 
     Empty mReply -> do 
      reply <- mReply 
      case reply of 
      Ok _ _ _ -> manyLengthErr 
      Error parseErr -> pure . Empty . pure $ Ok 0 parseState parseErr 
     Consumed mReply -> do 
      reply <- mReply 
      case reply of 
      Ok a newState parseErr -> walk 0 a newState parseErr 
      Error parseErr -> pure . Consumed . pure $ Error parseErr 
     where 
     walk 
      :: Int 
      -> a 
      -> State s u 
      -> ParseError 
      -> m (Consumed (m (Reply s u Int))) 
     walk !i _ parseState' _ = do 
      consumed <- runParsecT p parseState' 
      case consumed of 
      Empty mReply -> do 
       reply <- mReply 
       case reply of 
       Ok _ _ _ -> manyLengthErr 
       Error parseErr -> 
        pure . Consumed . pure $ Ok (i + 1) parseState' parseErr 
      Consumed mReply -> do 
       reply <- mReply 
       case reply of 
       Ok a newState parseErr -> walk (i + 1) a newState parseErr 
       Error parseErr -> pure . Consumed . pure $ Error parseErr 

manyLengthErr :: Monad m => m a 
manyLengthErr = 
    fail "manyLengthLowLevel can't be used on parser that accepts empty input" 

Tout comme manyLength, manyLengthLowLevel ne s'exécute pas dans l'espace de segment de mémoire constant.

---

Est-il possible d'écrire manyLength il fonctionne dans l'espace tas constant même sans l'écrire dans un style CPS? Si non, pourquoi pas? Y a-t-il une raison fondamentale pour laquelle c'est possible dans le style CPS mais pas dans un style non-CPS?

Answer 1

Cela s'exécute dans l'espace de tas constant. L'idée est d'essayer d'abord p, et effectuer explicitement une analyse de cas sur le résultat de son succès pour décider s'il faut exécuter go ou non, de sorte que go se retrouve en position d'appel de queue.

manyLength 
    :: Monad m 
    => ParsecT s u m a -> ParsecT s u m Int 
manyLength p = go 0 
    where 
    go :: Int -> ParsecT s u m Int 
    go !i = do 
     success <- (p *> pure True) <|> pure False 
     if success then go (i+1) else pure i