Rewrite Indentation in a monadic (and somewhat less cryptic) way

fco2/Indentation.hs

@@ -1,8 +1,18 @@
 -- | Parse indentation in occam source.
-module Indentation (parseIndentation, indentMarker, outdentMarker, eolMarker) where
+module Indentation (removeIndentation, indentMarker, outdentMarker, eolMarker) where
 
+import Control.Monad
+import Control.Monad.State
 import Data.List
 
+import Errors
+import ParseState
+import Pass
+
+-- FIXME When this joins continuation lines, it should stash the details of
+-- what it joined into ParseState so that error reporting later on can
+-- reconstruct the original position.
+
 -- FIXME this doesn't handle multi-line strings
 -- FIXME or VALOF processes
 -- FIXME or continuation lines...
@@ -11,42 +21,109 @@ indentMarker = "__indent"
 outdentMarker = "__outdent"
 eolMarker = "__eol"
 
-countIndent :: String -> Int -> Int
--- Tabs are 8 spaces.
-countIndent ('\t':cs) lineNum = 4 + (countIndent cs lineNum)
-countIndent (' ':' ':cs) lineNum = 1 + (countIndent cs lineNum)
-countIndent (' ':cs) lineNum = error $ "Bad indentation at line " ++ show lineNum
-countIndent _ _ = 0
+-- FIXME: There's probably a nicer way of doing this.
+-- (Well, trivially, use a WriterT...)
 
-stripIndent :: String -> String
-stripIndent (' ':cs) = stripIndent cs
-stripIndent cs = cs
-
-stripComment :: String -> Int -> String
-stripComment [] _ = []
-stripComment ('-':'-':s) _ = []
-stripComment ('"':s) lineNum = '"' : stripCommentInString s lineNum
-stripComment (c:s) lineNum = c : stripComment s lineNum
-
-stripCommentInString :: String -> Int -> String
-stripCommentInString [] lineNum = error $ "In string at end of line " ++ show lineNum
-stripCommentInString ('"':s) lineNum = '"' : stripComment s lineNum
-stripCommentInString (c:s) lineNum = c : stripCommentInString s lineNum
-
-parseIndentation :: [String] -> String
-parseIndentation ls = concat $ intersperse "\n" $ lines
+removeIndentation :: String -> PassM String
+removeIndentation orig
+    =  do modify $ (\ps -> ps { psIndentLinesIn = lines orig,
+                                psIndentLinesOut = [] })
+          -- FIXME Catch errors and figure out the source position based on the
+          -- input lines.
+          nextLine 0
+          ps <- get
+          let out = concat $ intersperse "\n" $ reverse $ psIndentLinesOut ps
+          modify $ (\ps -> ps { psIndentLinesIn = [],
+                                psIndentLinesOut = [] })
+          return out
   where
-    (initSuffix, lines) = flatten' ls 0 1
-    rep n i = concat $ take n (repeat i)
-    flatten' [] level lineNum = ("", [rep level (' ' : outdentMarker)])
-    flatten' (s:ss) level lineNum
-      | isBlankLine      = let (suffix, rest) = flatten' ss level (lineNum + 1) in (suffix, "" : rest)
-      | newLevel > level = (rep (newLevel - level) (' ' : indentMarker), processed : rest)
-      | newLevel < level = (rep (level - newLevel) (' ' : outdentMarker), processed : rest)
-      | otherwise        = ("", processed : rest)
-      where newLevel = countIndent s lineNum
-            stripped' = stripComment s lineNum
-            isBlankLine = stripIndent stripped' == ""
-            processed = (if isBlankLine then "" else (stripped' ++ (' ' : eolMarker))) ++ suffix
-            (suffix, rest) = flatten' ss newLevel (lineNum + 1)
+    -- | Get the next raw line from the input.
+    getLine :: PassM (Maybe String)
+    getLine
+        =  do ps <- get
+              case psIndentLinesIn ps of
+                [] -> return Nothing
+                (line:rest) ->
+                  do put $ ps { psIndentLinesIn = rest }
+                     return $ Just line
+
+    -- | Add a line to the output.
+    putLine :: String -> PassM ()
+    putLine line
+        = modify $ (\ps -> ps { psIndentLinesOut = line : psIndentLinesOut ps })
+
+    -- | Append to the *previous* line added.
+    addToLine :: String -> PassM ()
+    addToLine s
+        = modify $ (\ps -> ps { psIndentLinesOut =
+                                  case psIndentLinesOut ps of (l:ls) -> ((l ++ s):ls) })
+
+    -- | Given a line, read the rest of it, then return the complete thing.
+    finishLine :: String -> String -> Bool -> PassM String
+    finishLine left soFar inStr
+        = case (left, inStr) of
+            ([], False) -> plainEOL
+            ('-':'-':cs, False) -> plainEOL
+            ([], True) -> die "end of line in string without continuation"
+            (['*'], True) -> stringEOL
+            ('"':cs, iS) -> finishLine cs ('"':soFar) (not iS)
+            ('*':'"':cs, True) -> finishLine cs ('"':'*':soFar) True
+            (c:cs, iS) -> finishLine cs (c:soFar) iS
+      where
+        -- FIXME check if this should have a continuation
+        plainEOL = return $ reverse soFar
+        -- FIXME implement
+        stringEOL = die "string continues"
+
+    -- | Get the next *complete* line from the input, resolving continuations.
+    readLine :: PassM (Maybe String)
+    readLine
+        =  do line <- getLine
+              case line of
+                Just s ->
+                  do r <- finishLine s "" False
+                     return $ Just r
+                Nothing -> return Nothing
+
+    -- | Compute the indentation level of a line, and return it without the indentation.
+    countIndent :: String -> Int -> PassM (Int, String)
+    -- Tabs are 8 spaces.
+    countIndent ('\t':cs) soFar = countIndent cs (soFar + 4)
+    countIndent (' ':' ':cs) soFar = countIndent cs (soFar + 1)
+    countIndent (' ':cs) soFar
+        = die "bad indentation (odd number of spaces)"
+    countIndent cs soFar = return (soFar, cs)
+
+    -- | Repeat a string N times.
+    rep :: Int -> String -> String
+    rep n s = concat $ take n (repeat s)
+
+    -- | Process the next line from the input.
+    nextLine :: Int -> PassM ()
+    nextLine level
+        =  do l <- readLine
+              case l of
+                Nothing -> return ()
+                Just line ->
+                  do (newLevel, stripped) <- countIndent line 0
+                     addLine level newLevel stripped
+
+    -- | Once a line's been retrieved, add it to the output along with the
+    -- appropriate markers, then go and process the next one.
+    addLine :: Int -> Int -> String -> PassM ()
+    addLine level newLevel line
+      | line == "" =
+        do putLine ""
+           nextLine level
+      | newLevel > level =
+        do addToLine $ rep (newLevel - level) (" " ++ indentMarker)
+           putLine $ line ++ " " ++ eolMarker
+           nextLine newLevel
+      | newLevel < level =
+        do addToLine $ rep (level - newLevel) (" " ++ outdentMarker)
+           putLine $ line ++ " " ++ eolMarker
+           nextLine newLevel
+      | otherwise =
+        do putLine $ line ++ " " ++ eolMarker
+           nextLine level
 

fco2/Main.hs

@@ -52,9 +52,6 @@ getOpts argv =
     (_,_,errs) -> error (concat errs ++ usageInfo header options)
   where header = "Usage: fco [OPTION...] SOURCEFILE"
 
-numberedListing :: String -> String
-numberedListing s = concat $ intersperse "\n" $ [(show n) ++ ": " ++ s | (n, s) <- zip [1..] (lines s)]
-
 main :: IO ()
 main = do
   argv <- getArgs

fco2/Parse.hs

@@ -1747,14 +1747,10 @@ sourceFile
 --{{{  preprocessor
 -- XXX Doesn't handle conditionals.
 
-preprocess :: String -> String
-preprocess d = parseIndentation $ lines (d ++ "\n" ++ mainMarker)
-
 readSource :: String -> IO String
 readSource file
     =  do f <- IO.openFile file IO.ReadMode
-          d <- IO.hGetContents f
-          return $ preprocess d
+          IO.hGetContents f
 
 -- | Find (via a nasty regex search) all the files that this source file includes.
 preFindIncludes :: String -> [String]
@@ -1787,7 +1783,10 @@ loadSource file = load file file
                 Just _ -> return ()
                 Nothing ->
                   do progress $ "Loading source file " ++ realName
-                     source <- liftIO $ readSource realName
+                     rawSource <- liftIO $ readSource realName
+                     source <- removeIndentation (rawSource ++ "\n" ++ mainMarker)
+                     debug $ "Preprocessed source:"
+                     debug $ numberLines source
                      modify $ (\ps -> ps { psSourceFiles = (file, source) : psSourceFiles ps })
                      let deps = map mangleModName $ preFindIncludes source
                      sequence_ [load dep (joinPath realName dep) | dep <- deps]

fco2/ParseState.hs

@@ -17,6 +17,8 @@ data ParseState = ParseState {
 
     -- Set by preprocessor
     psSourceFiles :: [(String, String)],
+    psIndentLinesIn :: [String],
+    psIndentLinesOut :: [String],
 
     -- Set by Parse
     psLocalNames :: [(String, A.Name)],
@@ -45,6 +47,8 @@ emptyState = ParseState {
     psOutputFile = "-",
 
     psSourceFiles = [],
+    psIndentLinesIn = [],
+    psIndentLinesOut = [],
 
     psLocalNames = [],
     psMainLocals = [],

fco2/Pass.hs

@@ -3,6 +3,7 @@ module Pass where
 
 import Control.Monad.Error
 import Control.Monad.State
+import Data.List
 import System.IO
 
 import qualified AST as A
@@ -56,3 +57,9 @@ debugAST p
           debug $ pshow ps
           debug $ "}}}"
 
+-- | Number lines in a piece of text.
+numberLines :: String -> String
+numberLines s
+    = concat $ intersperse "\n" $ [show n ++ ": " ++ s
+                                   | (n, s) <- zip [1..] (lines s)]
+