diff -urN cabal/Distribution/PreProcess/Unlit.hs cabal-new/Distribution/PreProcess/Unlit.hs --- cabal/Distribution/PreProcess/Unlit.hs 2005-10-13 09:11:28.000000000 +0200 +++ cabal-new/Distribution/PreProcess/Unlit.hs 2006-10-09 20:54:36.000000000 +0200 @@ -18,36 +18,27 @@ import Data.Char --- exports: - -unlit :: String -> String -> String -unlit file lhs = (unlines . map unclassify . adjacent file (0::Int) Blank - . classify 0) (tolines lhs) +data Classified = Program String | Blank | Comment + | Include Int String | Pre String -plain :: String -> String -> String -- no unliteration +plain :: String -> String -> String -- no unliteration plain _ hs = hs ----- - -data Classified = Program String | Blank | Comment - | Include Int String | Pre String -classify :: Int -> [String] -> [Classified] -classify _ [] = [] -classify _ (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs - where allProg [] = [] -- Should give an error message, but I have no - -- good position information. - allProg (('\\':x'):xs') | x' == "end{code}" = Blank : classify 0 xs' - allProg (x':xs') = Program x':allProg xs' -classify 0 (('>':x):xs) = let (sp,code) = span isSpace x in - Program code : classify (length sp + 1) xs -classify n (('>':x):xs) = Program (drop (n-1) x) : classify n xs -classify _ (('#':x):xs) = - (case words x of - (line:file:_) | all isDigit line -> Include (read line) file - _ -> Pre x - ) : classify 0 xs -classify _ (x:xs) | all isSpace x = Blank:classify 0 xs -classify _ (_:xs) = Comment:classify 0 xs +classify :: [String] -> [Classified] +classify [] = [] +classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs + where allProg [] = [] -- Should give an error message, + -- but I have no good position information. + allProg (('\\':x):xs) | x == "end{code}" = Blank : classify xs + allProg (x:xs) = Program x:allProg xs +classify (('>':x):xs) = Program (' ':x) : classify xs +classify (('#':x):xs) = (case words x of + (line:file:_) | all isDigit line + -> Include (read line) file + _ -> Pre x + ) : classify xs +classify (x:xs) | all isSpace x = Blank:classify xs +classify (x:xs) = Comment:classify xs unclassify :: Classified -> String unclassify (Program s) = s @@ -56,51 +47,39 @@ unclassify Blank = "" unclassify Comment = "" -adjacent :: String -> Int -> Classified -> [Classified] -> [Classified] -adjacent file 0 _ (x :xs) = x: adjacent file 1 x xs - -- force evaluation of line number -adjacent file n (Program _) (Comment :_) = - error (message file n "program" "comment") -adjacent _ _ y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs +-- | 'unlit' takes a filename (for error reports), and transforms the +-- given string, to eliminate the literate comments from the program text. +unlit :: FilePath -> String -> String +unlit file lhs = (unlines + . map unclassify + . adjacent file (0::Int) Blank + . classify) (inlines lhs) + +adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified] +adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number +adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment") +adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs -adjacent file n Comment ((Program _) :_) = - error (message file n "comment" "program") -adjacent _ _ y@Comment (x@(Include i f):xs) = x: adjacent f i y xs +adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program") +adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs -adjacent _ _ y@Blank (x@(Include i f):xs) = x: adjacent f i y xs +adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs -adjacent file n _ (x :xs) = x: adjacent file (n+1) x xs -adjacent _ _ _ [] = [] +adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs +adjacent file n _ [] = [] -message :: (Show a) => String -> a -> String -> String -> String message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" -message file n p c = "In file " ++ file ++ " at line " - ++show n++": "++p++ " line before "++c++" line.\n" +message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n" --- Re-implementation of 'lines', for better efficiency (but decreased --- laziness). Also, importantly, accepts non-standard DOS and Mac line --- ending characters. -tolines :: String -> [String] -tolines s' = lines' s' id +-- Re-implementation of 'lines', for better efficiency (but decreased laziness). +-- Also, importantly, accepts non-standard DOS and Mac line ending characters. +inlines s = lines' s id where lines' [] acc = [acc []] - lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS - lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS - lines' ('\n':s) acc = acc [] : lines' s id -- Unix + lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS + lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS + lines' ('\n':s) acc = acc [] : lines' s id -- Unix lines' (c:s) acc = lines' s (acc . (c:)) - - -{- --- A very naive version of unliteration.... -module Unlit(unlit) where --- This version does not handle \begin{code} & \end{code}, and it is --- careless with indentation. -unlit = map unlitline - -unlitline ('>' : s) = s -unlitline _ = "" --} -