diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs index 5ce6387..1465562 100644 --- a/src/HsLexer.lhs +++ b/src/HsLexer.lhs @@ -10,7 +10,7 @@ > import Data.Char ( isSpace, isUpper, isLower, isDigit, isAlphaNum, isPunctuation ) > import qualified Data.Char ( isSymbol ) > import Control.Monad -> import Control.Monad.Error () +> import Control.Monad.Error.Class () > import Document > import Auxiliaries > import TeXCommands ( Lang(..) ) @@ -27,6 +27,7 @@ A Haskell lexer, based on the Prelude function \hs{lex}. > | Char String > | String String > | Special Char +> | SpecialS String > | Comment String > | Nested String > | Pragma String @@ -62,6 +63,7 @@ hierarchical modules. Also added Pragma. > string (Char s) = s > string (String s) = s > string (Special c) = [c] +> string (SpecialS s) = s > string (Comment s) = "--" ++ s > string (Nested s) = "{-" ++ s ++ "-}" > string (Pragma s) = "{-#" ++ s ++ "#-}" @@ -91,18 +93,19 @@ The main function. ks, 28.08.2008: New: Agda and Haskell modes. > lexify :: Lang -> [Char] -> Either Exc [Token] -> lexify lang [] = return [] +> lexify _lang [] = return [] > lexify lang s@(_ : _) = case lex' lang s of > Nothing -> Left ("lexical error", s) > Just (t, s') -> do ts <- lexify lang s'; return (t : ts) > > lex' :: Lang -> String -> Maybe (Token, String) -> lex' lang "" = Nothing -> lex' lang ('\'' : s) = do let (t, u) = lexLitChar s +> lex' _lang "" = Nothing +> lex' _lang ('\'' : '[' : s) = Just (SpecialS "\'[", s) +> lex' lang ('\'' : s0) = do let (t, u) = lexLitChar s0 > case match "\'" u of > Just v -> return (Char ("'" ++ t ++ "'"), v) > Nothing -> do -> (t', u') <- lex' lang s +> (t', u') <- lex' lang s0 > case t' of > Conid s -> return (Conid ('\'' : s), u') > Consym s -> return (Consym ('\'' : s), u') @@ -110,25 +113,26 @@ ks, 28.08.2008: New: Agda and Haskell modes. > Special c -> return (Consym (['\'', c]), u') > _ -> Nothing > -> lex' lang ('"' : s) = do let (t, u) = lexLitStr s +> lex' _lang ('"' : s) = do let (t, u) = lexLitStr s > v <- match "\"" u > return (String ("\"" ++ t ++ "\""), v) > lex' lang ('-' : '-' : s) > | not (null s') && isSymbol lang (head s') > = case s' of > (c : s'') -> return (varsymid lang ("--" ++ d ++ [c]), s'') +> _ -> fail "lex' --" > | otherwise = return (Comment t, u) > where (d, s') = span (== '-') s > (t, u) = break (== '\n') s' -> lex' lang ('{' : '-' : '"' : s) +> lex' _lang ('{' : '-' : '"' : s) > = do let (t, u) = inlineTeX s > v <- match "\"-}" u > return (TeX True (Text t), v) -> lex' lang ('{' : '-' : '#' : s) +> lex' _lang ('{' : '-' : '#' : s) > = do let (t, u) = nested 0 s > v <- match "#-}" u > return (Pragma t, v) -> lex' lang ('{' : '-' : s) = do let (t, u) = nested 0 s +> lex' _lang ('{' : '-' : s) = do let (t, u) = nested 0 s > v <- match "-}" u > return (Nested t, v) > lex' lang (c : s) @@ -145,10 +149,10 @@ ks, 28.08.2008: New: Agda and Haskell modes. > where > numeral Agda = Varid > numeral Haskell = Numeral -> classify s -> | s `elem` keywords lang -> = Keyword s -> | otherwise = Varid s +> classify s0 +> | s0 `elem` keywords lang +> = Keyword s0 +> | otherwise = Varid s0 > > > lexFracExp :: String -> Maybe (String, String) @@ -171,8 +175,11 @@ ks, 28.08.2008: New: Agda and Haskell modes. > lexDigits' :: String -> Maybe (String, String) > lexDigits' s = do (cs@(_ : _), t) <- Just (span isDigit s); return (cs, t) +> varsymid :: Lang -> String -> Token > varsymid Agda = Varid > varsymid Haskell = Varsym +> +> consymid :: Lang -> String -> Token > consymid Agda = Conid > consymid Haskell = Consym @@ -340,7 +347,7 @@ non-separators. > data CatCode = White > | Sep -> | Del Char +> | Del String > | NoSep > deriving (Eq) @@ -371,8 +378,9 @@ an improvement. > catCode (Char _) = NoSep > catCode (String _) = NoSep > catCode (Special c) -> | c `elem` "([{}])" = Del c +> | c `elem` "([{}])" = Del [c] > | otherwise = Sep +> catCode (SpecialS s) = Del s \NB Only @([])@ are classified as delimiters; @{}@ are separators since they do not bracket expressions. diff --git a/src/Math.lhs b/src/Math.lhs index 9dde1af..89c15f0 100644 --- a/src/Math.lhs +++ b/src/Math.lhs @@ -97,9 +97,9 @@ Primitive parser. > sep, noSep, left :: (CToken tok) => Parser tok tok > sep = satisfy (\t -> catCode t == Sep) > noSep = satisfy (\t -> catCode t == NoSep) -> left = satisfy (\t -> case catCode t of Del c -> c `elem` "(["; _-> False) +> left = satisfy (\t -> case catCode t of Del c -> c `elem` ["(", "[", "'["]; _-> False) > right l = satisfy (\c -> case (catCode l, catCode c) of -> (Del o, Del c) -> (o,c) `elem` zip "([" ")]" +> (Del o, Del c) -> (o,c) `elem` zip ["(","["] [")","]"] > _ -> False) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/MathCommon.lhs b/src/MathCommon.lhs index 25559c3..de93b27 100644 --- a/src/MathCommon.lhs +++ b/src/MathCommon.lhs @@ -164,7 +164,7 @@ inherits the position of the original token. > | optional = (Mandatory, set l s ++ args es) > | otherwise = (Optional False, [l] ++ s ++ [r] ++ args es) > where (flag, s) = eval e -> optional = catCode l == Del '(' && not (mandatory e) +> optional = catCode l == Del "(" && not (mandatory e) > && case flag of Mandatory -> False; Optional f -> opt || f \NB It is not a good idea to remove parentheses around atoms, because diff --git a/src/MathPoly.lhs b/src/MathPoly.lhs index e5c224b..889980d 100644 --- a/src/MathPoly.lhs +++ b/src/MathPoly.lhs @@ -129,10 +129,10 @@ Primitive parser. > sep, noSep, left, anyright :: (CToken tok) => Parser tok tok > sep = satisfy (\t -> catCode t == Sep) > noSep = satisfy (\t -> catCode t == NoSep) -> left = satisfy (\t -> case catCode t of Del c -> c `elem` "([{"; _ -> False) -> anyright = satisfy (\t -> case catCode t of Del c -> c `elem` ")]}"; _ -> False) +> left = satisfy (\t -> case catCode t of Del c -> c `elem` ["(","[","{","'["]; _ -> False) +> anyright = satisfy (\t -> case catCode t of Del c -> c `elem` [")","]","}"]; _ -> False) > right l = satisfy (\c -> case (catCode l, catCode c) of -> (Del o, Del c) -> (o,c) `elem` zip "([{" ")]}" +> (Del o, Del c) -> (o,c) `elem` zip ["(","[","{","'["] [")","]","}","]"] > _ -> False) > `mplus` do eof > return (fromToken $ TeX False Empty) diff --git a/src/Typewriter.lhs b/src/Typewriter.lhs index aa4f06c..b1a0d83 100644 --- a/src/Typewriter.lhs +++ b/src/Typewriter.lhs @@ -54,6 +54,7 @@ > tex _ (Char s) = sub'char (catenate (map conv' (init $ tail s))) -- NEW: remove quotes > tex _ (String s) = sub'string (catenate (map conv' (init $ tail s))) -- NEW: remove quotes > tex _ (Special c) = sub'special (replace Empty [c] (conv False c)) +> tex _ (SpecialS s) = sub'special (replace Empty s (convert False s)) > tex _ (Comment s) = sub'comment (Embedded s) > tex _ (Nested s) = sub'nested (Embedded s) > tex _ (Pragma s) = sub'pragma (Embedded s) diff --git a/src/Version.lhs.in b/src/Version.lhs.in index 383fda3..3e6f159 100644 --- a/src/Version.lhs.in +++ b/src/Version.lhs.in @@ -21,12 +21,14 @@ Used internally to distinguish prereleases. > pre :: Int > pre = @PRE@ +> isWindows :: Bool > isWindows = "win" `isPrefixOf` os || "Win" `isPrefixOf` os % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Search path} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - +> searchPath :: [FilePath] > searchPath = "." : > [ deep (joinPath (env "HOME" : [p ++ x])) > | p <- ["","."] @@ -50,6 +52,7 @@ Used internally to distinguish prereleases. > ,"lhs2TeX" > ] > +> stydir :: FilePath > stydir = replace (replace "@stydir@" "datarootdir" "@datarootdir@") "prefix" "@prefix@" > where replace x w y | ("$" ++ w) `isPrefixOf` x = y ++ drop (length w + 1) x > | ("${" ++ w ++ "}") `isPrefixOf` x = y ++ drop (length w + 3) x