%-------------------------------= -------------------------------------------- \subsection{Math formatter} %-------------------------------= -------------------------------------------- %if codeOnly || showModuleHeader > module Math ( module Math, substitute, number ) > where > > import Prelude hiding ( lines ) > import Data.List ( partition ) > import Numeric ( showFFloat ) > import Control.Applicative > import Control.Arrow ( (>>>) ) > import Control.Monad ( (>=>) ) > > import Verbatim ( expand, trim ) > import MathCommon > import Document > import Directives > import HsLexer > import Parser > import Auxiliaries > import TeXCommands ( Lang(..) ) %endif % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Inline and display code} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - > inline :: Lang -> Formats -> Bool -> String -> Either Exc Doc > inline lang fmts auto = fmap unNL > >>> tokenize lang > >=> lift (number 1 1) > >=> when auto (lift (filter (isNotSpace . token))) > >=> lift (partition (\t -> catCode t /= White)) > >=> exprParse *** return > >=> lift (substitute fmts auto) *** return > >=> lift (uncurry merge) > >=> lift (fmap token) > >=> when auto (lift addSpaces) > >=> lift (latexs fmts) > >=> lift sub'inline > display :: Lang -> Formats -> Bool -> (Stack, Stack) -> Maybe Int > -> String -> Either Exc (Doc, (Stack,Stack)) > display lang fmts auto sts col= lift trim > >=> lift (expand 0) > >=> tokenize lang > >=> lift (number 1 1) > >=> when auto (lift (filter (isNotSpace . token))) > >=> lift (partition (\t -> catCode t /= White)) > >=> exprParse *** return > >=> lift (substitute fmts auto) *** return > >=> lift (uncurry merge) > >=> lift lines > >=> lift (align col) > >=> when auto (lift (fmap (fmap addSpaces))) > >=> lift (leftIndent fmts auto sts) > >=> lift sub'code *** return % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{A very simple Haskell Parser} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - The parser is based on the Smugweb parser. This variant cannot handle unbalanced parentheses. > exprParse :: (CToken tok, Show tok) => [Pos tok] -> Either Exc [Item (Pos tok)] > exprParse s = case run chunk s of > Nothing -> Left ("syntax error", show s) -- HACK: |show s| > Just e -> Right e > > chunk :: (CToken tok) => Parser (Pos tok) (Chunk (Pos tok)) > chunk = do a <- many atom > as <- many (do s <- sep; a' <- many atom; return (Delim s : offside a')) > return (offside a ++ concat as) > where offside [] = [] > -- old: |opt a = [Apply a]| > offside (a : as) = Apply (a : bs) : offside cs > where (bs, cs) = span (\a' -> col' a < col' a') as > col' (Atom a) = poscol a > col' (Paren a _ _) = poscol a > > atom :: (CToken tok) => Parser (Pos tok) (Atom (Pos tok)) > atom = fmap Atom noSep > <|> do l <- left > e <- chunk > r <- right l > return (Paren l e r) 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) > > right :: (CToken tok) => tok -> Parser tok tok > right l = satisfy (\c' -> case (catCode l, catCode c') of > (Del o, Del c) -> (o,c) `elem` zip "([" ")]" > _ -> False) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Internal alignment} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \Todo{Internal alignment Spalte automatisch bestimmen. Vorsicht: die Position von |=| oder |::| heranzuziehen ist gef"ahrlich; wenn z.B. |let x = e| in einem |do|-Ausdruck vorkommt.} > data Line a = Blank > | Three a a a > | Multi a > > align :: (CToken tok) => Maybe Int -> [[Pos tok]] -> [Line [Pos tok]] > align c = fmap (maybe Multi split3 c) > where > split3 i ts = case span (\t -> poscol t < i) ts of > ([], []) -> Blank > ((_ : _), []) -> Multi ts > (us, v : vs) > | poscol v == i && isInternal v > -> Three us [v] vs > | null us -> Three [] [] (v : vs) > | otherwise -> Multi ts > > > isInternal :: (CToken tok) => tok -> Bool > isInternal t = case token t of > Consym _ -> True > Varsym _ -> True > Special _ -> True > _ -> False > > instance Functor Line where > fmap _f Blank = Blank > fmap f (Three l c r) = Three (f l) (f c) (f r) > fmap f (Multi a) = Multi (f a) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Adding spaces} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - Inserting spaces before and after keywords. We use a simple finite automata with three states: |before b| means before a keyword, |b| indicates whether to insert a space or not; |after| means immediately after a keyword (hence |before b| really means not immediately after). > addSpaces :: (CToken tok) => [tok] -> [tok] > addSpaces ts0 = before False ts0 > where > before _b [] = [] > before b (t : ts) = case token t of > u | selfSpacing u -> t : before False ts > Special c > | c `elem` ",;([{" -> t : before False ts > Keyword _ -> [ fromToken (TeX False sub'space) | b ] ++ t : after ts > _ -> t : before True ts > > after [] = [] > after (t : ts) = case token t of > u | selfSpacing u -> t : before False ts > Special c > | c `elem` ",;([{" -> fromToken (TeX False sub'space) : t : before False ts > Keyword _ -> fromToken (TeX False sub'space) : t : after ts > _ -> fromToken (TeX False sub'space) : t : before True ts Operators are `self spacing'. > selfSpacing :: Token -> Bool > selfSpacing (Consym _) = True > selfSpacing (Varsym _) = True > selfSpacing (Op _) = True > -- |selfSpacing (TeX _) = True| > selfSpacing _ = False \NB It's not a good idea to regard inline \TeX\ as self spacing consider, for example, a macro like @%format mu = "\mu "@. % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Left indentation} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - Auch wenn |auto = False| wird der Stack auf dem laufenden gehalten. > type Stack = [(Col, Doc, [Pos Token])] > > leftIndent :: > Formats > -> Bool > -> (Stack, Stack) > -> [Line [Pos Token]] > -> (Doc, (Stack, Stack)) > leftIndent dict auto (lst0, rst0) > = loop lst0 rst0 > where > copy d | auto = d > | otherwise = Empty Die Funktion |isInternal| pr"uft, ob |v| ein spezielles Symbol wie @::@, @=@ etc~oder ein Operator wie @++@ ist. > loop lst rst [] = (Empty, (lst, rst)) > loop lst rst (l' : ls) = case l' of > Blank -> loop lst rst ls > Three l c r -> (sub'column3 (copy lskip <<>> latexs dict l) > (latexs dict c) > (copy rskip <<>> latexs dict r) <<>> sep' ls <<>> rest, st') > where (lskip, lst') = indent l lst > (rskip, rst') = indent r rst > (rest, st') = loop lst' rst' ls -- does not work: |if null l && null c then rst' else []| > Multi m -> (sub'column1 (copy lskip <<>> latexs dict m) <<>> sep' ls <<>> rest, st') > where (lskip, lst') = indent m lst > (rest, st') = loop lst' [] ls > > sep' [] = Empty > sep' (Blank : _ ) = sub'blankline > sep' (_ : _) = sub'nl > > indent :: [Pos Token] -> Stack -> (Doc, Stack) > indent [] stack = (Empty, stack) > indent ts@(t : _) [] = (Empty, [(poscol t, Empty, ts)]) > indent ts@(t : _) (top@(c, skip, line) : stack) > = case compare (poscol t) c of > LT -> indent ts stack > EQ -> (skip, (c, skip, ts) : stack) > GT -> (skip', (poscol t, skip', ts) : top : stack) > where > skip' = case span (\u -> poscol u < poscol t) line of > (us, v : _vs) | poscol v == poscol t > -> skip <<>> sub'phantom (latexs dict us) > -- does not work: |(us, _) -> skip ++ [Phantom (fmap token us), Skip (col t - last (c : fmap col us))]| > _ -> skip <<>> sub'hskip (Text em) > where em = showFFloat (Just 2) (0.5 * fromIntegral (poscol t - c) :: Double) "" M"ussen |v| und |t| zueinander passen? % \begin{verbatim} where |a = where |Str c = [ [ ( { |(b, c) = |c@(..)= , | , ; ] ] ) } \end{verbatim}