lhs2tex-1.21: src/MathCommon.lhs
%-------------------------------= --------------------------------------------
\subsection{Common code for math and poly formatters}
%-------------------------------= --------------------------------------------
ks, 15.06.2004: I have moved common code from the math and poly formatters
to this module. Poly has been created from a copy of the old math formatter,
therefore there has been much overlap between the two modules.
> module MathCommon ( module MathCommon )
> where
> import Typewriter ( latex )
> import Document
> import Directives ( Formats )
> import HsLexer
> import qualified FiniteMap as FM
> import Auxiliaries
>
> import Control.Applicative
> when :: Monad m => Bool -> (a -> m a) -> (a -> m a)
> when True f = f
> when False _f = return
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Adding positional information}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
> type Row = Int
> type Col = Int
>
> data Pos a = Pos {posrow :: !Row, poscol :: !Col, posann :: a}
> deriving (Show)
%{
%format r1
%format r2
%format c1
%format c2
> instance Eq (Pos a) where
> Pos r1 c1 _ == Pos r2 c2 _= r1 == r2 && c1 == c2
> instance Ord (Pos a) where
> Pos r1 c1 _ <= Pos r2 c2 _= (r1, c1) <= (r2, c2)
> pos2string :: Pos a -> String
> pos2string (Pos r c _) = "'" ++ show r ++ "_" ++ show c
%}
> instance (CToken tok) => CToken (Pos tok) where
> catCode (Pos _ _ t) = catCode t
> token (Pos _ _ t) = token t
> inherit (Pos r c t') t = Pos r c (inherit t' t)
> fromToken t = Pos 0 0 (fromToken t)
Numbering the list of tokens.
> number :: Row -> Col -> [Token] -> [Pos Token]
> number _r _c [] = []
> number r c (t : ts) = Pos r c t : number r' c' ts
> where (r', c') = count r c (string t)
>
> count :: Row -> Col -> String -> (Row, Col)
> count r c [] = (r, c)
> count r c (a : s)
> | a == '\n' = count (r + 1) 1 s
> | otherwise = count r (c + 1) s
Splitting the token list in lines.
> lines :: [Pos a] -> [[Pos a]]
> lines = split 1
> where
> split _ [] = []
> split r ts = us : split (r + 1) vs
> where (us, vs) = span (\t -> posrow t <= r) ts
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{A very simple Haskell Parser}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
ks, 27.06.2003: I'll add some explanation which reflects the way I understand
things. Since I don't know Smugweb and I haven't written the code below, it is
possible that the explanation is not adequate:
A |Chunk| is a sequence of \emph{delimiters} or \emph{applications}. Delimiters
are keywords or operators. Applications are everything else.
An |application| is a sequence of atoms that are forming a Haskell
function application. The list must never be empty, but can contain
a single element (for instance, in normal infix expressions such as |2 + 3|
this will occur frequently).
An |atom| is a single identifier (not an operator, though -- those are
delimiters), or a chunk in parentheses.
> type Chunk a = [Item a]
>
> data Item a = Delim a
> | Apply [Atom a]
> deriving (Show)
>
> data Atom a = Atom a
> | Paren a (Chunk a) a
> deriving (Show)
The parser itself differs between the two styles. The math formatter
cannot handle unbalanced parentheses, the poly formatter has a heuristic
that allows successful parsing of unbalanced parentheses in many, but
not all cases.
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Making replacements}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
> data Mode = Mandatory
> | Optional Bool
If |eval e| returns |Mandatory| then parenthesis around |e| must not be
dropped; |Optional True| indicates that it can be dropped; |Optional
False| indicates that the decision is up the caller.
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Making replacements}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
ks, 23.07.2003: This substitute function does not work recursively.
To change this is on my TODO list. Substitutions without arguments,
hovewer, do work recursively because they are handled again at a later
stage (by the call to latexs, for instance in leftIndent).
> substitute :: (CToken tok,Show tok) => Formats -> Bool -> Chunk (Pos tok) -> [Pos tok]
> substitute d auto chunk = snd (eval chunk)
> where
> eval :: (CToken tok) => [Item (Pos tok)] -> (Mode,[Pos tok])
> eval [e] = eval' e
> eval chunk' = (Optional False, concat [ snd (eval' i) | i <- chunk' ])
>
> eval' :: (CToken tok) => Item (Pos tok) -> (Mode,[Pos tok])
> eval' (Delim s) = (Optional False, [s])
> eval' (Apply []) = impossible "eval'"
> eval' (Apply (e : es)) = eval'' False e es
>
> eval'' :: (CToken tok) => Bool -> Atom (Pos tok) -> [Atom (Pos tok)] -> (Mode,[Pos tok])
> eval'' _ (Atom s) es = case FM.lookup (string (token s) ++ pos2string s) d <|> FM.lookup (string (token s)) d of
> Nothing -> (Optional False, s : args es)
> Just (opt, opts, lhs, rhs)-> (Optional opt, set s (concat (fmap sub rhs)) ++ args bs)
> where
> (as, bs) | m <= n = (es ++ replicate (n - m) dummy, [])
> | otherwise = splitAt n es
> n = length lhs
> m = length es
> binds = zip lhs [ snd (eval'' b a []) | (b, a) <- zip opts as ]
> sub t@(Varid x) = case FM.lookup x (FM.fromList binds) of
> Nothing -> [fromToken t]
> Just ts -> ts
> sub t = [fromToken t]
Whenever a token is replaced or removed, the first token of the replacement
inherits the position of the original token.
> eval'' opt (Paren l e r) es
> | isOptional = (Mandatory, set l s ++ args es)
> | otherwise = (Optional False, [l] ++ s ++ [r] ++ args es)
> where (flag, s) = eval e
> isOptional = 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
that would remove the parentheses in @deriving (Eq)@ and @module M (a)@
as well.
> args :: (CToken tok) => [Atom (Pos tok)] -> [Pos tok]
> args es = concat [ sp ++ snd (eval'' False i []) | i <- es ] -- $\cong$ Applikation
> sp :: (CToken tok) => [Pos tok]
> sp | auto = [fromToken (TeX False sub'space)]
> | otherwise = []
To support macros of the form @%format Parser (a) = a@.
> set :: (CToken tok) => tok -> [tok] -> [tok]
> set _s [] = []
> set s (t : ts) = inherit s (token t) : ts
>
> mandatory :: (CToken tok) => Chunk tok -> Bool
> mandatory _e = False
Code before:
< mandatory e = null e -- nullary tuple
< || or [ isComma i | i <- e ] -- tuple
< || isOp (head e) -- left section
< || isOp (last e) -- right section
> isComma, isOp :: (CToken tok) => Item tok -> Bool
> isComma (Delim t) = case token t of
> Special c -> c == ','
> _ -> False
> isComma _ = False
>
> isOp (Delim t) = case token t of
> Special c -> c == '`' -- f"ur @` div `@
> Consym _ -> True
> Varsym s -> s /= "\\"
> Op _ -> True
> _ -> False
> isOp _ = False
> dummy :: (CToken tok) => Atom tok
> dummy = Atom (fromToken (Varid ""))
\NB We cannot use embedded \TeX\ text here, because |TeX| is not a
legal atom (|string| is applied to it).
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Adding spaces and indentation}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
There are subtle differences between the two styles.
For inline-code.
> latexs :: (CToken tok) => Formats -> [tok] -> Doc
> latexs dict = catenate . fmap (latex sub'space sub'space dict . token)