futhark fmt: remove trailing comment machinery.

It was too complicated and too weird and I'm not convinced it produced
appreciably nicer output.

src/Futhark/Fmt/Monad.hs

@@ -166,18 +166,15 @@ localLayoutList a m = do
     MultiLine -> local (const $ fromMaybe lo $ lineLayoutList a) m
     SingleLine -> m
 
--- | This function uses the location of @a@ and prepends comments if the
--- comments location is less than the location of @a@. It format @b@ in
--- accordance with if @a@ is singleline or multiline using 'localLayout'. At last
--- it internally sets the state of the 'FmtM' monad to consider trailing
--- comments if they exists. This function should be always used when possible to
--- wrap Fmt around. It currently does not handle trailing comment perfectly.
--- See tests/fmt/traillingComments1.fut or the other test.
+-- | This function uses the location of @a@ and prepends comments if
+-- the comments location is less than the location of @a@. It format
+-- @b@ in accordance with if @a@ is singleline or multiline using
+-- 'localLayout'. It currently does not handle trailing comment
+-- perfectly. See tests/fmt/traillingComments*.fut.
 addComments :: (Located a) => a -> Fmt -> Fmt
 addComments a b = localLayout a $ do
   c <- fmtComments a
   f <- b
-  setTrailingComment a
   pure $ c <> f
 
 prependComments :: (a -> Loc) -> (a -> Fmt) -> a -> Fmt
@@ -209,8 +206,6 @@ data FmtState = FmtState
     comments :: [Comment],
     -- | The original source file that is being formatted.
     file :: BS.ByteString,
-    -- | Pending comment to be inserted before next newline (reverse order).
-    pendingComments :: !(Maybe Comment),
     -- | Keeps track of what type the last output was.
     lastOutput :: !(Maybe LastOutput)
   }
@@ -229,17 +224,24 @@ data Layout = MultiLine | SingleLine deriving (Show, Eq)
 type FmtM a = ReaderT Layout (State FmtState) a
 
 fmtComment :: Comment -> Fmt
-fmtComment = comment . commentText
+fmtComment c = comment $ commentText c
 
 fmtCommentList :: [Comment] -> Fmt
 fmtCommentList [] = nil
-fmtCommentList (c : cs) = fst $ foldl f (fmtComment c, locOf c) cs
+fmtCommentList (c : cs) =
+  fst $ foldl f (fmtComment c, locOf c) cs
   where
     f (acc, loc) c' =
       if consecutive loc (locOf c')
         then (acc <> fmtComment c', locOf c')
         else (acc <> hardline <> fmtComment c', locOf c')
 
+hasComment :: (Located a) => a -> FmtM Bool
+hasComment a =
+  gets $ not . null . takeWhile relevant . comments
+  where
+    relevant c = locOf a /= NoLoc && locOf a > locOf c
+
 -- | Prepends comments.
 fmtComments :: (Located a) => a -> Fmt
 fmtComments a = do
@@ -248,34 +250,10 @@ fmtComments a = do
     then pure mempty
     else do
       modify $ \s -> s {comments = later}
-      pre
-        <> fmtCommentList here
+      fmtCommentList here
         <> if consecutive (locOf here) (locOf a) then nil else hardline
   where
     relevant c = locOf a /= NoLoc && locOf a > locOf c
-    pre = do
-      lastO <- gets lastOutput
-      case lastO of
-        Nothing -> nil
-        Just Line -> nil
-        Just _ -> modify (\s -> s {lastOutput = Just Line}) >> hardline
-
--- | If the next comment is a trailing comment then it is added to be a pending
--- comment that is added at next line.
-setTrailingComment :: (Located a) => a -> FmtM ()
-setTrailingComment a = do
-  s <- get
-  case comments s of
-    c : cs | locOf a /= NoLoc -> case (locOf a, locOf c) of
-      -- comment on same line as term a
-      (Loc _sALoc eALoc, Loc _sCLoc eCLoc) | posLine eALoc == posLine eCLoc -> do
-        put $
-          s
-            { comments = cs,
-              pendingComments = Just c
-            }
-      _any -> pure ()
-    _ -> pure ()
 
 -- | Determines the layout of @a@ by checking if it spans a single line or two
 -- or more lines.
@@ -339,7 +317,6 @@ runFormat format cs file = evalState (runReaderT format e) s
       FmtState
         { comments = cs,
           file = T.encodeUtf8 file,
-          pendingComments = Nothing,
           lastOutput = Nothing
         }
     e = MultiLine
@@ -357,22 +334,12 @@ nest i a = a <|> (P.nest i <$> a)
 space :: Fmt
 space = modify (\s -> s {lastOutput = Just Space}) >> pure P.space
 
--- | Forces a line to be used regardless of layout, this should ideally not be
--- used.
+-- | Forces a line to be used regardless of layout, this should
+-- ideally not be used.
 hardline :: Fmt
 hardline = do
-  pc <- gets pendingComments
-  case pc of
-    Just c -> do
-      modify $ \s ->
-        s
-          { pendingComments = Nothing,
-            lastOutput = Just Line
-          }
-      space <> fmtComment c
-    Nothing -> do
-      modify $ \s -> s {lastOutput = Just Line}
-      pure P.line
+  modify $ \s -> s {lastOutput = Just Line}
+  pure P.line
 
 -- | A line or a space depending on layout.
 line :: Fmt
@@ -389,8 +356,6 @@ comment c = do
   modify (\s -> s {lastOutput = Just Line})
   pure $ P.annotate commentStyle (P.pretty (T.stripEnd c)) <> P.line
 
--- In order to handle trailing comments its VERY important to
--- evaluate the seperator after each element in the list.
 sep :: Fmt -> [Fmt] -> Fmt
 sep _ [] = nil
 sep s (a : as) = auxiliary a as
@@ -432,7 +397,7 @@ stdNest = nest 2
 -- | Aligns line by line.
 align :: Fmt -> Fmt
 align a = do
-  modify (\s -> s {lastOutput = Nothing}) -- XXX?
+  modify (\s -> s {lastOutput = Just Line}) -- XXX?
   P.align <$> a
 
 -- | Indents everything by @i@, should never be used.
@@ -502,14 +467,15 @@ consecutive _ _ = False
 -- sepereate by two lines.
 sepDecs :: (Located a) => (a -> Fmt) -> [a] -> Fmt
 sepDecs _ [] = nil
-sepDecs fmt as@(x : xs) =
-  sep space (map fmt as) <|> (fmt x <> auxiliary x xs)
+sepDecs fmt decs@(x : xs) =
+  sep space (map fmt decs) <|> (fmt x <> auxiliary x xs)
   where
     auxiliary _ [] = nil
     auxiliary prev (y : ys) = p <> fmt y <> auxiliary y ys
       where
-        p =
-          case (lineLayout y, lineLayout prev) of
-            (Just SingleLine, Just SingleLine)
+        p = do
+          commented <- hasComment y
+          case (commented, lineLayout y, lineLayout prev) of
+            (False, Just SingleLine, Just SingleLine)
               | consecutive (locOf prev) (locOf y) -> hardline
             _any -> hardline <> hardline

src/Futhark/Fmt/Printer.hs

@@ -22,7 +22,7 @@ import Language.Futhark.Parser
   )
 
 lineIndent :: (Located a) => a -> Fmt -> Fmt -> Fmt
-lineIndent l a b = fmtByLayout l (a <+> b) (a </> hardStdIndent b)
+lineIndent l a b = fmtByLayout l (a <+> b) (a </> hardStdIndent (align b))
 
 fmtName :: AnsiStyle -> Name -> Fmt
 fmtName style = text style . nameToText
@@ -85,15 +85,16 @@ fmtArray xs loc =
   addComments loc $ fmtByLayout loc singleLine multiLine
   where
     singleLine = brackets $ sep ", " xs
-    multiLine = align $ "[" <+> sep (line <> "," <> space) xs </> "]"
+    multiLine =
+      align $ "[" <+> sep (line <> "," <> space) xs </> "]"
 
 instance Format UncheckedTypeExp where
   fmt (TEVar v loc) = addComments loc $ fmtQualName v
-  fmt (TETuple ts loc) = fmtTuple (map fmt ts) loc
+  fmt (TETuple ts loc) = fmtTuple (map (align . fmt) ts) loc
   fmt (TEParens te loc) = addComments loc $ parens $ fmt te
   fmt (TERecord fs loc) = fmtRecord (map fmtFieldType fs) loc
     where
-      fmtFieldType (L _ name', t) = fmtName mempty name' <> ":" <+> fmt t
+      fmtFieldType (L _ name', t) = fmtName mempty name' <> ":" <+> align (fmt t)
   fmt (TEArray se te loc) = addComments loc $ fmt se <> fmt te
   fmt (TEUnique te loc) = addComments loc $ "*" <> fmt te
   fmt (TEApply te tArgE loc) = addComments loc $ fmt te <+> fmt tArgE
@@ -166,7 +167,8 @@ instance Format (UncheckedPat t) where
       -- has the same location.
       fmtFieldPat (L nameloc name, t)
         | locOf nameloc == locOf t = fmt name
-        | otherwise = lineIndent [nameloc, locOf t] (fmt name <+> "=") (fmt t)
+        | otherwise =
+            lineIndent [nameloc, locOf t] (fmt name <+> "=") (fmt t)
   fmt (PatParens pat loc) =
     addComments loc $ "(" <> align (fmt pat) <:/> ")"
   fmt (Id name _ loc) = addComments loc $ fmtBoundName name
@@ -236,9 +238,9 @@ instance Format UncheckedExp where
   fmt (Literal _v loc) = addComments loc $ fmtCopyLoc constantStyle loc
   fmt (IntLit _v _ loc) = addComments loc $ fmtCopyLoc constantStyle loc
   fmt (FloatLit _v _ loc) = addComments loc $ fmtCopyLoc constantStyle loc
-  fmt (TupLit es loc) = fmtTuple (map fmt es) loc
+  fmt (TupLit es loc) = fmtTuple (map (align . fmt) es) loc
   fmt (RecordLit fs loc) = fmtRecord (map fmt fs) loc
-  fmt (ArrayLit es _ loc) = fmtArray (map fmt es) loc
+  fmt (ArrayLit es _ loc) = fmtArray (map (align . fmt) es) loc
   fmt (StringLit _s loc) = addComments loc $ fmtCopyLoc constantStyle loc
   fmt (Project k e _ loc) = addComments loc $ fmt e <> "." <> fmt k
   fmt (Negate e loc) = addComments loc $ "-" <> fmt e

tests_fmt/comment.fut

@@ -4,6 +4,7 @@
 
 -- another comment   
 
-def f x = x + 2
+def f x = (--comment in paren
+    x + 2)
 
 -- and a final one

tests_fmt/expected/comment.fut

@@ -3,6 +3,8 @@
 
 -- another comment
 
-def f x = x + 2
+def f x =
+  (--comment in paren
+   x + 2)
 
 -- and a final one

tests_fmt/expected/records.fut

@@ -8,8 +8,9 @@ type b = {a: i32, b: i32}
 type c =
   { a: i32
   , b: i32
-  , c: ( bool -- comment here
-       , bool
+  , c: ( bool
+       , -- comment here
+         bool
        , bool
        )
   }
@@ -21,4 +22,10 @@ def main =
   let x = {a, b, c}
   let {a, b, c} = x
   let {a = a, b = b, c = c} = x
+  let x =
+    { a = a
+    , b =
+        b
+    , c
+    }
   in x

tests_fmt/expected/trailingComments1.fut

@@ -1,14 +1,19 @@
 -- Here is one comment
 -- Now I'll add some code
 
-type test = (i32, i32) -- here we have a trailing comments
+type test = (i32, i32)
+
+-- here we have a trailing comments
 
 -- lets add some more code
 
 def record =
-  { a = 1 -- trying trailing
-  , b = 2 -- in multiline comment
-  ,
+  { a = 1
+  , -- trying trailing
+  b = 2
+  , -- in multiline comment
   -- also a test comment here
-  c = 3 -- one last comment
+  c = 3
   }
+
+-- one last comment

tests_fmt/expected/trailingComments2.fut

@@ -1,8 +1,9 @@
 def a =
   ( 0
-  ,
-  -- Test 0
-  1 -- Test 1
+  , -- Test 0
+    1
   )
 
+-- Test 1
+
 def b = 1

tests_fmt/records.fut

@@ -19,4 +19,8 @@ def main =
   let x = {a, b, c}
   let {a,b,c} = x
   let {a=a,b=b,c=c} = x
+  let x = {a = a
+          , b =
+              b,
+          c}
   in x