From 5e7c9403cc511fc79ce428b9465f4d6205487265 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Thu, 26 Apr 2007 01:56:23 +0000 Subject: [PATCH] Rewrite Indentation in a monadic (and somewhat less cryptic) way --- fco2/Indentation.hs | 151 +++++++++++++++++++++++++++++++++----------- fco2/Main.hs | 3 - fco2/Parse.hs | 11 ++-- fco2/ParseState.hs | 4 ++ fco2/Pass.hs | 7 ++ 5 files changed, 130 insertions(+), 46 deletions(-) diff --git a/fco2/Indentation.hs b/fco2/Indentation.hs index e136dff..7222e25 100644 --- a/fco2/Indentation.hs +++ b/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 diff --git a/fco2/Main.hs b/fco2/Main.hs index 50ce7d7..06a572f 100644 --- a/fco2/Main.hs +++ b/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 diff --git a/fco2/Parse.hs b/fco2/Parse.hs index de13f80..7ca8a0f 100644 --- a/fco2/Parse.hs +++ b/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] diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 9bdf7f6..94cab2a 100644 --- a/fco2/ParseState.hs +++ b/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 = [], diff --git a/fco2/Pass.hs b/fco2/Pass.hs index 6f967bf..ef2369e 100644 --- a/fco2/Pass.hs +++ b/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)] +