"Committed_by_peb"

This commit is contained in:
peb
2005-02-24 10:46:37 +00:00
parent d669e538d6
commit 59b378a4e5
43 changed files with 786 additions and 493 deletions

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Date: 2005/02/24 11:46:35 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.15 $
-- > CVS $Revision: 1.16 $
--
-- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001
--
@@ -239,8 +239,13 @@ errAndMsg (Ok a) = return (a,[])
-- | a three-valued maybe type to express indirections
data Perhaps a b = Yes a | May b | Nope deriving (Show,Read,Eq,Ord)
yes :: a -> Perhaps a b
yes = Yes
may :: b -> Perhaps a b
may = May
nope :: Perhaps a b
nope = Nope
mapP :: (a -> c) -> Perhaps a b -> Perhaps c b
@@ -419,6 +424,7 @@ paragraphs = map unlines . chop . lines where
indent :: Int -> String -> String
indent i s = replicate i ' ' ++ s
(+++), (++-), (++++), (+++++) :: String -> String -> String
a +++ b = a ++ " " ++ b
a ++- "" = a
a ++- b = a +++ b
@@ -432,26 +438,31 @@ prUpper s = s1 ++ s2' where
c:t -> toUpper c : t
_ -> s2
prReplicate :: Int -> String -> String
prReplicate n s = concat (replicate n s)
prTList :: String -> [String] -> String
prTList t ss = case ss of
[] -> ""
[s] -> s
s:ss -> s ++ t ++ prTList t ss
prQuotedString :: String -> String
prQuotedString x = "\"" ++ restoreEscapes x ++ "\""
prParenth :: String -> String
prParenth s = if s == "" then "" else "(" ++ s ++ ")"
prCurly, prBracket :: String -> String
prCurly s = "{" ++ s ++ "}"
prBracket s = "[" ++ s ++ "]"
prArgList xx = prParenth (prTList "," xx)
prArgList, prSemicList, prCurlyList :: [String] -> String
prArgList = prParenth . prTList ","
prSemicList = prTList " ; "
prCurlyList = prCurly . prSemicList
restoreEscapes :: String -> String
restoreEscapes s =
case s of
[] -> []
@@ -476,6 +487,7 @@ prIfEmpty em _ _ [] = em
prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2
-- | Thomas Hallgren's wrap lines
wrapLines :: Int -> String -> String
wrapLines n "" = ""
wrapLines n s@(c:cs) =
if isSpace c
@@ -491,15 +503,17 @@ wrapLines n s@(c:cs) =
--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
-- LaTeX code producing functions
dollar, mbox, ital, boldf, verbat :: String -> String
dollar s = '$' : s ++ "$"
mbox s = "\\mbox{" ++ s ++ "}"
ital s = "{\\em" +++ s ++ "}"
boldf s = "{\\bf" +++ s ++ "}"
verbat s = "\\verbat!" ++ s ++ "!"
mkLatexFile :: String -> String
mkLatexFile s = begindocument +++++ s +++++ enddocument
begindocument, enddocument :: String
begindocument =
"\\documentclass[a4paper,11pt]{article}" ++++ -- M.F. 25/01-02
"\\setlength{\\parskip}{2mm}" ++++
@@ -510,7 +524,6 @@ begindocument =
"\\setlength{\\textheight}{240mm}" ++++
"\\setlength{\\textwidth}{158mm}" ++++
"\\begin{document}\n"
enddocument =
"\n\\end{document}\n"

View File

@@ -5,9 +5,9 @@
-- Stability : Almost Obsolete
-- Portability : Haskell 98
--
-- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Date: 2005/02/24 11:46:35 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.4 $
-- > CVS $Revision: 1.5 $
--
-- some parser combinators a la Wadler and Hutton.
-- no longer used in many places in GF
@@ -142,24 +142,45 @@ lits ts = literals ts
jL :: String -> Parser Char String
jL = pJ . lits
pParenth :: Parser Char a -> Parser Char a
pParenth p = literal '(' +.. pJunk +.. p ..+ pJunk ..+ literal ')'
pCommaList p = pTList "," (pJ p) -- p,...,p
pOptCommaList p = pCommaList p ||| succeed [] -- the same or nothing
pArgList p = pParenth (pCommaList p) ||| succeed [] -- (p,...,p), poss. empty
pArgList2 p = pParenth (p ... jL "," +.. pCommaList p) *** uncurry (:) -- min.2 args
-- | p,...,p
pCommaList :: Parser Char a -> Parser Char [a]
pCommaList p = pTList "," (pJ p)
-- | the same or nothing
pOptCommaList :: Parser Char a -> Parser Char [a]
pOptCommaList p = pCommaList p ||| succeed []
-- | (p,...,p), poss. empty
pArgList :: Parser Char a -> Parser Char [a]
pArgList p = pParenth (pCommaList p) ||| succeed []
-- | min. 2 args
pArgList2 :: Parser Char a -> Parser Char [a]
pArgList2 p = pParenth (p ... jL "," +.. pCommaList p) *** uncurry (:)
longestOfSome :: Parser a b -> Parser a [b]
longestOfSome p = (p ... longestOfMany p) *** (\ (x,y) -> x:y)
pIdent :: Parser Char String
pIdent = pLetter ... longestOfMany pAlphaPlusChar *** uncurry (:)
where alphaPlusChar c = isAlphaNum c || c=='_' || c=='\''
pLetter, pDigit :: Parser Char Char
pLetter = satisfy (`elem` (['A'..'Z'] ++ ['a'..'z'] ++
['À' .. 'Û'] ++ ['à' .. 'û'])) -- no such in Char
pDigit = satisfy isDigit
pLetters = longestOfSome pLetter
pDigit = satisfy isDigit
pLetters :: Parser Char String
pLetters = longestOfSome pLetter
pAlphanum, pAlphaPlusChar :: Parser Char Char
pAlphanum = pDigit ||| pLetter
pAlphaPlusChar = pAlphanum ||| satisfy (`elem` "_'")
pQuotedString :: Parser Char String
pQuotedString = literal '"' +.. pEndQuoted where
pEndQuoted =
literal '"' *** (const [])

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Date: 2005/02/24 11:46:35 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $
-- > CVS $Revision: 1.7 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -26,16 +26,16 @@ import List (isPrefixOf, isSuffixOf, intersperse)
-- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003
newtype Str = Str [Tok] deriving (Read, Show, Eq, Ord)
-- | notice that having both pre and post would leave to inconsistent situations:
--
-- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}
--
-- always violates a condition expressed by the one or the other
data Tok =
TK String
| TN Ss [(Ss, [String])] -- ^ variants depending on next string
--- | TP Ss [(Ss, [String])] -- variants depending on previous string
deriving (Eq, Ord, Show, Read)
-- ^ notice that having both pre and post would leave to inconsistent situations:
--
-- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}
--
-- always violates a condition expressed by the one or the other
-- | a variant can itself be a token list, but for simplicity only a list of strings

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Date: 2005/02/24 11:46:36 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $
-- > CVS $Revision: 1.7 $
--
-- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001
-----------------------------------------------------------------------------
@@ -62,6 +62,7 @@ data Path a =
| Node ([Tr a], (Path a, a), [Tr a])
deriving Show
leaf :: a -> Tr a
leaf a = Tr (a,[])
newtype Loc a = Loc (Tr a, Path a) deriving Show
@@ -132,6 +133,7 @@ goBackN i st
-- added mappings between locations and trees
loc2tree :: Loc a -> Tr a
loc2tree (Loc (t,p)) = case p of
Top -> t
Node (left,(p',v),right) ->
@@ -143,8 +145,10 @@ loc2treeMarked (Loc (Tr (a,ts),p)) =
where
(mark, nomark) = (\a -> (a,True), \a -> (a, False))
tree2loc :: Tr a -> Loc a
tree2loc t = Loc (t,Top)
goRoot :: Loc a -> Loc a
goRoot = tree2loc . loc2tree
goLast :: Loc a -> Err (Loc a)