Como faço para tornar esse algoritmo mais preguiçoso sem me repetir?

(Inspirado pela minha resposta a esta pergunta .)

Considere este código (ele deve encontrar o maior elemento que é menor ou igual a uma determinada entrada):

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing where
  precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
  precise closestSoFar Leaf = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise closestSoFar l
    EQ -> Just (k, v)
    GT -> precise (Just (k, v)) r

Isso não é muito preguiçoso. Depois que o GTcaso é inserido, sabemos com certeza que o valor final de retorno será Justalgo em vez de Nothing, mas o Justainda não estará disponível até o final. Eu gostaria de tornar isso mais preguiçoso para que ele Justfique disponível assim que o GTcaso for inserido. Meu caso de teste para isso é que eu quero Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)avaliar em Truevez de chegar ao fundo. Aqui está uma maneira de pensar em fazer isso:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess _ Leaf = Nothing
closestLess i (Node k v l r) = case i `compare` k of
  LT -> closestLess i l
  EQ -> Just (k, v)
  GT -> Just (precise (k, v) r)
  where
    precise :: (Integer, v) -> TreeMap v -> (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> (k, v)
      GT -> precise (k, v) r

No entanto, agora estou me repetindo: a lógica principal está agora em ambos closestLesse em precise. Como posso escrever isso para que seja preguiçoso, mas sem me repetir?

Em vez de usar wrappers explícitos, você pode aproveitar o sistema de tipos. Observe que a versão preciseusada Maybepara o seu primeiro trecho de código:

precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Just (k, v)
  GT -> precise (Just (k, v)) r

é quase exatamente o mesmo algoritmo da versão precisesem Maybedo seu segundo trecho de código, que pode ser escrito no Identityfunctor como:

precise :: Identity (Integer, v) -> TreeMap v -> Identity (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Identity (k, v)
  GT -> precise (Identity (k, v)) r

Eles podem ser unificados em uma versão polimórfica no Applicative:

precise :: (Applicative f) => f (Integer, v) -> TreeMap v -> f (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> pure (k, v)
  GT -> precise (pure (k, v)) r

Por si só, isso não realiza muito, mas se sabemos que o GTramo sempre retornará um valor, podemos forçá-lo a executar no Identityfunctor, independentemente do functor inicial. Ou seja, podemos iniciar no Maybefunctor, mas recorrer ao Identityfunctor no GTramo:

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing
  where
    precise :: (Applicative t) => t (Integer, v) -> TreeMap v -> t (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> pure (k, v)
      GT -> pure . runIdentity $ precise (Identity (k, v)) r

Isso funciona bem com seu caso de teste:

> isJust $ closestLess 5 (Node 3 () Leaf undefined)
True

e é um bom exemplo de recursão polimórfica.

Outra coisa legal dessa abordagem do ponto de vista do desempenho é que -ddump-simplmostra que não há wrappers ou dicionários. Tudo foi apagado no nível de tipo com funções especializadas para os dois functores:

closestLess
  = \ @ v i eta ->
      letrec {
        $sprecise
        $sprecise
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise closestSoFar l;
                    EQ -> (k, v2) `cast` <Co:5>;
                    GT -> $sprecise ((k, v2) `cast` <Co:5>) r
                  }
              }; } in
      letrec {
        $sprecise1
        $sprecise1
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise1 closestSoFar l;
                    EQ -> Just (k, v2);
                    GT -> Just (($sprecise ((k, v2) `cast` <Co:5>) r) `cast` <Co:4>)
                  }
              }; } in
      $sprecise1 Nothing eta

A partir de minha implementação não preguiçosa, primeiro refatorei precisepara receber Justcomo argumento e generalizei seu tipo de acordo:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> precise wrap (wrap (k, v)) r

Então, eu mudei para fazer wrapcedo e chame-se de idno GTcaso:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> wrap (precise id (k, v) r)

Isso ainda funciona exatamente como antes, exceto pelo benefício da preguiça adicionada.

Eu acho que a versão do CPS que você respondeu consigo mesma é a melhor, mas para completar, aqui estão mais algumas idéias. (EDIT: A resposta de Buhr agora é a que tem maior desempenho.)

A primeira idéia é se livrar do " closestSoFar" acumulador e, em vez disso, deixar o GTcaso lidar com toda a lógica de escolher o valor mais à direita menor que o argumento. Nesse formulário, o GTcaso pode retornar diretamente um Just:

closestLess1 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess1 _ Leaf = Nothing
closestLess1 i (Node k v l r) =
  case i `compare` k of
    LT -> closestLess1 i l
    EQ -> Just (k, v)
    GT -> Just (fromMaybe (k, v) (closestLess1 i r))

Isso é mais simples, mas ocupa um pouco mais de espaço na pilha quando você atinge muitos GTcasos. Tecnicamente, você pode até usá-lo fromMaybena forma de acumulador (ou seja, substituindo o fromJustimplícito na resposta de luqui), mas isso seria um ramo redundante e inacessível.

A outra idéia de que realmente existem duas "fases" do algoritmo, uma antes e uma depois que você pressiona a GT, então você o define por um booleano para representar essas duas fases e usa tipos dependentes para codificar o invariante de que sempre haverá um resultar na segunda fase.

data SBool (b :: Bool) where
  STrue :: SBool 'True
  SFalse :: SBool 'False

type family MaybeUnless (b :: Bool) a where
  MaybeUnless 'True a = a
  MaybeUnless 'False a = Maybe a

ret :: SBool b -> a -> MaybeUnless b a
ret SFalse = Just
ret STrue = id

closestLess2 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess2 i = precise SFalse Nothing where
  precise :: SBool b -> MaybeUnless b (Integer, v) -> TreeMap v -> MaybeUnless b (Integer, v)
  precise _ closestSoFar Leaf = closestSoFar
  precise b closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise b closestSoFar l
    EQ -> ret b (k, v)
    GT -> ret b (precise STrue (k, v) r)

E se

GT -> let Just v = precise (Just (k,v) r) in Just v

?

Não apenas sabemos sempre Just, depois de sua primeira descoberta, também sempre sabemos Nothing até então. Na verdade, são duas "lógicas" diferentes.

Então, vamos para a esquerda antes de tudo, para tornar isso explícito:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) 
                 deriving (Show, Read, Eq, Ord)

closestLess :: Integer 
            -> TreeMap v 
            -> Maybe (Integer, v)
closestLess i = goLeft 
  where
  goLeft :: TreeMap v -> Maybe (Integer, v)
  goLeft n@(Node k v l _) = case i `compare` k of
          LT -> goLeft l
          _  -> Just (precise (k, v) n)
  goLeft Leaf = Nothing

  -- no more maybe if we're here
  precise :: (Integer, v) -> TreeMap v -> (Integer, v)
  precise closestSoFar Leaf           = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
        LT -> precise closestSoFar l
        EQ -> (k, v)
        GT -> precise (k, v) r

O preço é que repetimos no máximo uma etapa no máximo uma vez.