Skip to content

Commit

Permalink
New unlit code "ported" from cpphs-1.2
Browse files Browse the repository at this point in the history
  • Loading branch information
@kolmodin
kolmodin committed Oct 9, 2006
1 parent 16a58fb commit 0e5d7d8
Showing 1 changed file with 42 additions and 63 deletions.
105 changes: 42 additions & 63 deletions Distribution/PreProcess/Unlit.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,36 +18,27 @@ module Distribution.PreProcess.Unlit(unlit,plain) where

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
Expand All @@ -56,51 +47,39 @@ unclassify (Include i f) = '#':' ':show i ++ ' ':f
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 _ = ""
-}

0 comments on commit 0e5d7d8

Please sign in to comment.