Skip to content

Commit

Permalink
tick square bracket '[ is a special char too
Browse files Browse the repository at this point in the history
  • Loading branch information
@phadej
phadej committed Dec 15, 2017
1 parent ab8912c commit 70a07b7
Show file tree
Hide file tree
Showing 6 changed files with 33 additions and 21 deletions.
38 changes: 23 additions & 15 deletions src/HsLexer.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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(..) )
Expand All @@ -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
Expand Down Expand Up @@ -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 ++ "#-}"
Expand Down Expand Up @@ -91,44 +93,46 @@ 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')
> Varsym s -> return (Varsym ('\'' : s), u')
> 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)
Expand All @@ -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)
Expand All @@ -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

Expand Down Expand Up @@ -340,7 +347,7 @@ non-separators.

> data CatCode = White
> | Sep
> | Del Char
> | Del String
> | NoSep
> deriving (Eq)

Expand Down Expand Up @@ -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.
Expand Down
4 changes: 2 additions & 2 deletions src/Math.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
Expand Down
2 changes: 1 addition & 1 deletion src/MathCommon.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/MathPoly.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
1 change: 1 addition & 0 deletions src/Typewriter.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
3 changes: 3 additions & 0 deletions src/Version.lhs.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 <- ["","."]
Expand All @@ -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
Expand Down

0 comments on commit 70a07b7

Please sign in to comment.