Writing Stack-Safe Code - Part 2

Main.purs

module Main where

import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), snd)
import Data.List (range, uncons, head)
import Data.List.Types (List(..), (:))
import Data.Either (Either(..))

import Effect (Effect)
import Effect.Console (log)
import TryPureScript as TryPureScript

start :: Int
start = 1

end :: Int
end = 100_000

highToLowList :: List Int
highToLowList = range end start
  
lowToHighList :: List Int
lowToHighList = range start end

main :: Effect Unit
main = TryPureScript.render =<< TryPureScript.withConsole do
  log $ append "safe version: " $ show $ join $ map head $ 
    zipOpposingOrder_safe highToLowList lowToHighList
  
  -- This has to be run after the safe version because nothing else else will
  -- run once the stack-overflow error occurs
  log $ append "unsafe version: " $ show $ join $ map head $ 
    zipOpposingOrder_unsafe highToLowList lowToHighList

zipOpposingOrder_unsafe :: forall a b. List a -> List b -> Maybe (List (Tuple a b))
zipOpposingOrder_unsafe revList normalList = map snd $ go revList normalList
  where
  go :: List a -> List b -> Maybe (Tuple (List a) (List (Tuple a b)))
  go revRemaining normalRemaining = case normalRemaining of
    Nil ->
      Just $ Tuple revRemaining Nil

    Cons headB tail -> do 
      -- We're using the Maybe monad here to make this easier to read.
      -- A `Nothing` will be produced if the normal list had more elements 
      -- than reversed one did at this particular level or
      -- if either one of the lists did at a deeper level

      -- finish zipping the tail first and return the remaining
      -- elements from the `revRemaining` list
      Tuple newRevRemaining newTail <- go revRemaining tail

      -- if the `newRevRemaining` has a value, zip it with this
      -- level's value, and return the tail for the parent's
      -- computation (if any)
      { head: headA, tail: revTail } <- uncons newRevRemaining
      pure $ Tuple revTail $ Cons (Tuple headA headB) newTail
  
zipOpposingOrder_safe :: forall a b. List a -> List b -> Maybe (List (Tuple a b))
zipOpposingOrder_safe reveredList normalList = go reveredList Nil (Left normalList)
  where
  -- To keep track of "where" we are in the data structure, we'll
  -- maintain our own stack of what else still needs to be done.
  --
  -- `Left` values represent items in the normal list we haven't yet changed.
  -- They will appear in a reversed order when we start consuming them.
  --
  -- `Right` values will either be the final list or the current state
  -- of the final list as it is being built.
  go :: List a
     -> List b
     -> Either (List b) (List (Tuple a b))
     -> Maybe (List (Tuple a b))
  go revList stack = case _ of
    Left (Cons head tail) ->
      -- we've hit the next element in the list
      -- remember, we can't merge the head value yet
      -- because it might not be the last element.
      go revList (head : stack) (Left tail)

    Left Nil ->
      -- we've hit the end of the normal list
      -- we can now start consuming the stack we've created
      go revList stack $ Right Nil

    Right val ->
      -- `val` is either the end of the final list (i.e. `Nil`)
      -- or the current state of the final list since we're
      -- still in the process of creating it.
      -- We need to look at the stack to see what to do
      case stack of
        -- `b` is the element next closest to the end of the normal list
        -- so we can now zip it together with the revList's next element
        -- (if it exists)
        Cons b restB -> case revList of
          Cons a restA ->
            go restA restB $ Right $ (Tuple a b) : val
            
          Nil ->
            Nothing -- more elems in normalList than in reversedList

        -- the stack is now empty, so we return the final list
        -- (assuming there wasn't any other values left in the reverse list).
        Nil -> case revList of
          Nil -> Just val
          Cons _ _ -> Nothing -- more elems in reversedList than in normalList