Make be stack safe

bower.json

@@ -16,7 +16,8 @@
     "purescript-console": "^3.0.0",
     "purescript-lists": "^4.12.0",
     "purescript-tuples": "^4.1.0",
-    "purescript-spec-quickcheck": "^2.0.0"
+    "purescript-spec-quickcheck": "^2.0.0",
+    "purescript-tailrec": "^3.3.0"
   },
   "devDependencies": {
     "purescript-psci-support": "^3.0.0",

src/Prettier/Printer.purs

@@ -34,10 +34,12 @@ module Prettier.Printer
 
 import Prelude
 
+import Control.Monad.Rec.Class (Step(..), tailRec)
 import Data.Array as Array
 import Data.Foldable (intercalate)
 import Data.List (List(Cons), (:))
 import Data.List as List
+import Data.Maybe (Maybe(..))
 import Data.Monoid (class Monoid)
 import Data.String (Pattern(..))
 import Data.String as String
@@ -99,22 +101,50 @@ copy i x = intercalate "" $ Array.replicate i x
 best :: Int -> Int -> DOC -> Doc
 best w k x = be w k $ List.singleton (Tuple 0 x)
 
+newtype State = State
+  { f :: Doc -> Doc
+  , k :: Int
+  , l :: List (Tuple Int DOC)
+  -- Based on the generated document, should it keep the result or try a new state
+  , next :: Maybe (Tuple (Doc -> Boolean) State)
+  }
+
 be :: Int -> Int -> List (Tuple Int DOC) -> Doc
-be w k List.Nil = Nil
-be w k (Cons (Tuple i NIL) z) = be w k z
-be w k (Cons (Tuple i (APPEND x y)) z) = be w k $ (Tuple i x) : (Tuple i y) : z
-be w k (Cons (Tuple i (NEST j x)) z) = be w k  $ (Tuple (i + j) x) : z
-be w k (Cons (Tuple i (TEXT s)) z) = Text s $ be w (k + String.length s) z
-be w k (Cons (Tuple i LINE) z) = Line i $ be w i z
-be w k (Cons (Tuple i (UNION x y)) z) =
-  let x' = be w k $ (Tuple i x) : z
-  in if fits (w - k) x' then x' else be w k $ (Tuple i y) : z
+be w k0 l0 = tailRec go $ State { f: id, k: k0, l: l0, next: Nothing }
+  where
+  go :: State -> Step State Doc
+  go (State { f, k, l, next }) = case l of
+    List.Nil ->
+      -- obtain the result by running the function on the empty document
+      let res = f Nil in
+      case next of
+        -- if this one fails, continue at the next state
+        Just (Tuple p st) | not p res ->
+          Loop st
+        -- otherwise return what we got
+        _ -> Done res
+    (Cons (Tuple _ NIL) z) -> Loop $
+      State { f, k, l: z, next }
+    (Cons (Tuple i (APPEND x y)) z) -> Loop $
+      State { f, k, l: (Tuple i x) : (Tuple i y) : z, next }
+    (Cons (Tuple i (NEST j x)) z) -> Loop $
+      State { f, k, l: (Tuple (i + j) x) : z, next }
+    (Cons (Tuple _ (TEXT s)) z) -> Loop $
+      State { f: f <<< Text s, k: (k + String.length s), l: z, next }
+    (Cons (Tuple i LINE) z) -> Loop $
+      State { f: f <<< Line i, k: i, l: z, next }
+    (Cons (Tuple i (UNION x y)) z) ->
+      let
+        -- add a continuation that tests whether the previous doc is too long
+        trial = Tuple (fits (w - k)) nextSt
+        nextSt = State { f, k, l: (Tuple i y) : z, next }
+      in  Loop $ State { f, k, l: (Tuple i x) : z, next: Just trial }
 
 fits :: Int -> Doc -> Boolean
-fits w x | w < 0 = false
-fits w Nil = true
+fits w _ | w < 0 = false
+fits _ Nil = true
 fits w (Text s x) = fits (w - String.length s) x
-fits w (Line i x) = true
+fits _ (Line _ _) = true
 
 pretty :: Int -> DOC -> String
 pretty w x = layout $ best w 0 x