mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-26 21:12:50 -06:00
"Committed_by_peb"
This commit is contained in:
@@ -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"
|
||||
|
||||
|
||||
@@ -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 [])
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user