mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-20 00:22:51 -06:00
"Committed_by_peb"
This commit is contained in:
@@ -1,20 +1,19 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : ErrM
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:14 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- hack for BNFC generated files. AR 21/9/2003
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module ErrM (
|
||||
module Operations
|
||||
) where
|
||||
module ErrM (module Operations
|
||||
) where
|
||||
|
||||
import Operations
|
||||
|
||||
|
||||
@@ -1,13 +1,13 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Glue
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:14 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
--
|
||||
-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -5,24 +5,23 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Map
|
||||
(
|
||||
module Map (
|
||||
Map,
|
||||
empty,
|
||||
isEmpty,
|
||||
(!), -- lookup operator.
|
||||
(!+), -- lookupMany operator.
|
||||
(|->), -- insert operator.
|
||||
(|->+), -- insertMany operator.
|
||||
(<+>), -- union operator.
|
||||
flatten --
|
||||
(!),
|
||||
(!+),
|
||||
(|->),
|
||||
(|->+),
|
||||
(<+>),
|
||||
flatten
|
||||
) where
|
||||
|
||||
import RedBlack
|
||||
@@ -38,20 +37,25 @@ infixl 4 <+>
|
||||
empty :: Map key el
|
||||
empty = emptyTree
|
||||
|
||||
-- | lookup operator.
|
||||
(!) :: Ord key => Map key el -> key -> Maybe el
|
||||
fm ! e = lookupTree e fm
|
||||
|
||||
-- | lookupMany operator.
|
||||
(!+) :: Ord key => Map key el -> [key] -> [Maybe el]
|
||||
fm !+ [] = []
|
||||
fm !+ (e:es) = (lookupTree e fm): (fm !+ es)
|
||||
|
||||
-- | insert operator.
|
||||
(|->) :: Ord key => (key,el) -> Map key el -> Map key el
|
||||
(x,y) |-> fm = insertTree (x,y) fm
|
||||
|
||||
-- | insertMany operator.
|
||||
(|->+) :: Ord key => [(key,el)] -> Map key el -> Map key el
|
||||
[] |->+ fm = fm
|
||||
((x,y):xs) |->+ fm = xs |->+ (insertTree (x,y) fm)
|
||||
|
||||
-- | union operator.
|
||||
(<+>) :: Ord key => Map key el -> Map key el -> Map key el
|
||||
(<+>) fm1 fm2 = xs |->+ fm2
|
||||
where xs = flatten fm1
|
||||
|
||||
@@ -1,18 +1,79 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Operations
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.15 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001
|
||||
--
|
||||
-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Operations where
|
||||
module Operations (-- * misc functions
|
||||
ifNull, onSnd,
|
||||
|
||||
-- * the Error monad
|
||||
Err(..), err, maybeErr, testErr, errVal, errIn, derrIn,
|
||||
performOps, repeatUntilErr, repeatUntil, okError, isNotError,
|
||||
showBad, lookupErr, lookupErrMsg, lookupDefault, updateLookupList,
|
||||
mapPairListM, mapPairsM, pairM, mapErr, mapErrN, foldErr,
|
||||
(!?), errList, singleton,
|
||||
|
||||
-- ** checking
|
||||
checkUnique, titleIfNeeded, errMsg, errAndMsg,
|
||||
|
||||
-- * a three-valued maybe type to express indirections
|
||||
Perhaps(..), yes, may, nope,
|
||||
mapP,
|
||||
unifPerhaps, updatePerhaps, updatePerhapsHard,
|
||||
|
||||
-- * binary search trees
|
||||
BinTree(..), isInBinTree, commonsInTree, justLookupTree,
|
||||
lookupTree, lookupTreeEq, lookupTreeMany, updateTree,
|
||||
updateTreeGen, updateTreeEq, updatesTree, updatesTreeNondestr, buildTree,
|
||||
sorted2tree, mapTree, mapMTree, tree2list,
|
||||
depthTree, mergeTrees,
|
||||
|
||||
-- * parsing
|
||||
WParser, wParseResults, paragraphs,
|
||||
|
||||
-- * printing
|
||||
indent, (+++), (++-), (++++), (+++++),
|
||||
prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
|
||||
prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
|
||||
numberedParagraphs, prConjList, prIfEmpty, wrapLines,
|
||||
|
||||
-- ** LaTeX code producing functions
|
||||
dollar, mbox, ital, boldf, verbat, mkLatexFile,
|
||||
begindocument, enddocument,
|
||||
|
||||
-- * extra
|
||||
sortByLongest, combinations, mkTextFile, initFilePath,
|
||||
|
||||
-- * topological sorting with test of cyclicity
|
||||
topoTest, topoSort,
|
||||
|
||||
-- * the generic fix point iterator
|
||||
iterFix,
|
||||
|
||||
-- * association lists
|
||||
updateAssoc, removeAssoc,
|
||||
|
||||
-- * chop into separator-separated parts
|
||||
chunks, readIntArg,
|
||||
|
||||
-- * state monad with error; from Agda 6\/11\/2001
|
||||
STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM, done,
|
||||
|
||||
-- * error monad class
|
||||
ErrorMonad(..), checkAgain, checks, allChecks
|
||||
|
||||
) where
|
||||
|
||||
import Char (isSpace, toUpper, isSpace, isDigit)
|
||||
import List (nub, sortBy, sort, deleteBy, nubBy)
|
||||
@@ -24,9 +85,6 @@ infixr 5 ++++
|
||||
infixr 5 +++++
|
||||
infixl 9 !?
|
||||
|
||||
-- some auxiliary GF operations. AR 19/6/1998 -- 6/2/2001
|
||||
-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL)
|
||||
|
||||
ifNull :: b -> ([a] -> b) -> [a] -> b
|
||||
ifNull b f xs = if null xs then b else f xs
|
||||
|
||||
@@ -35,7 +93,8 @@ onSnd f (x, y) = (x, f y)
|
||||
|
||||
-- the Error monad
|
||||
|
||||
data Err a = Ok a | Bad String -- like Maybe type with error msgs
|
||||
-- | like @Maybe@ type with error msgs
|
||||
data Err a = Ok a | Bad String
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
instance Monad Err where
|
||||
@@ -43,17 +102,18 @@ instance Monad Err where
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
instance Functor Err where -- added 2/10/2003 by PEB
|
||||
-- | added 2\/10\/2003 by PEB
|
||||
instance Functor Err where
|
||||
fmap f (Ok a) = Ok (f a)
|
||||
fmap f (Bad s) = Bad s
|
||||
|
||||
-- analogue of maybe
|
||||
-- | analogue of @maybe@
|
||||
err :: (String -> b) -> (a -> b) -> Err a -> b
|
||||
err d f e = case e of
|
||||
Ok a -> f a
|
||||
Bad s -> d s
|
||||
|
||||
-- add msg s to Maybe failures
|
||||
-- | add msg s to @Maybe@ failures
|
||||
maybeErr :: String -> Maybe a -> Err a
|
||||
maybeErr s = maybe (Bad s) Ok
|
||||
|
||||
@@ -66,7 +126,7 @@ errVal a = err (const a) id
|
||||
errIn :: String -> Err a -> Err a
|
||||
errIn msg = err (\s -> Bad (s ++++ "OCCURRED IN" ++++ msg)) return
|
||||
|
||||
-- used for extra error reports when developing GF
|
||||
-- | used for extra error reports when developing GF
|
||||
derrIn :: String -> Err a -> Err a
|
||||
derrIn m = errIn m -- id
|
||||
|
||||
@@ -121,14 +181,14 @@ mapPairsM f xys =
|
||||
pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
|
||||
pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)
|
||||
|
||||
-- like mapM, but continue instead of halting with Err
|
||||
-- | like @mapM@, but continue instead of halting with 'Err'
|
||||
mapErr :: (a -> Err b) -> [a] -> Err ([b], String)
|
||||
mapErr f xs = Ok (ys, unlines ss)
|
||||
where
|
||||
(ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs])
|
||||
fxs = map f xs
|
||||
|
||||
-- alternative variant, peb 9/6-04
|
||||
-- | alternative variant, peb 9\/6-04
|
||||
mapErrN :: Int -> (a -> Err b) -> [a] -> Err ([b], String)
|
||||
mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2))
|
||||
where
|
||||
@@ -139,8 +199,7 @@ mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2))
|
||||
nss = length ss
|
||||
fxs = map f xs
|
||||
|
||||
-- like foldM, but also return the latest value if fails
|
||||
|
||||
-- | like @foldM@, but also return the latest value if fails
|
||||
foldErr :: (a -> b -> Err a) -> a -> [b] -> Err (a, Maybe String)
|
||||
foldErr f s xs = case xs of
|
||||
[] -> return (s,Nothing)
|
||||
@@ -148,7 +207,7 @@ foldErr f s xs = case xs of
|
||||
Ok v -> foldErr f v xx
|
||||
Bad m -> return $ (s, Just m)
|
||||
|
||||
-- !! with the error monad
|
||||
-- @!!@ with the error monad
|
||||
(!?) :: [a] -> Int -> Err a
|
||||
xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs
|
||||
|
||||
@@ -177,8 +236,7 @@ errAndMsg :: Err a -> Err (a,[String])
|
||||
errAndMsg (Bad m) = Bad m
|
||||
errAndMsg (Ok a) = return (a,[])
|
||||
|
||||
-- a three-valued maybe type to express indirections
|
||||
|
||||
-- | a three-valued maybe type to express indirections
|
||||
data Perhaps a b = Yes a | May b | Nope deriving (Show,Read,Eq,Ord)
|
||||
|
||||
yes = Yes
|
||||
@@ -191,7 +249,7 @@ mapP f p = case p of
|
||||
May b -> May b
|
||||
Nope -> Nope
|
||||
|
||||
-- this is what happens when matching two values in the same module
|
||||
-- | this is what happens when matching two values in the same module
|
||||
unifPerhaps :: (Eq a, Eq b, Show a, Show b) =>
|
||||
Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
unifPerhaps p1 p2 = case (p1,p2) of
|
||||
@@ -200,7 +258,7 @@ unifPerhaps p1 p2 = case (p1,p2) of
|
||||
_ -> if p1==p2 then return p1
|
||||
else Bad ("update conflict between" ++++ show p1 ++++ show p2)
|
||||
|
||||
-- this is what happens when updating a module extension
|
||||
-- | this is what happens when updating a module extension
|
||||
updatePerhaps :: (Eq a,Eq b, Show a, Show b) =>
|
||||
b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
updatePerhaps old p1 p2 = case (p1,p2) of
|
||||
@@ -209,7 +267,7 @@ updatePerhaps old p1 p2 = case (p1,p2) of
|
||||
(_, May a) -> Bad "strange indirection"
|
||||
_ -> unifPerhaps p1 p2
|
||||
|
||||
-- here the value is copied instead of referred to; used for oper types
|
||||
-- | here the value is copied instead of referred to; used for oper types
|
||||
updatePerhapsHard :: (Eq a, Eq b, Show a, Show b) => b ->
|
||||
Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
|
||||
updatePerhapsHard old p1 p2 = case (p1,p2) of
|
||||
@@ -230,9 +288,9 @@ isInBinTree x tree = case tree of
|
||||
| x > a -> isInBinTree x right
|
||||
| x == a -> True
|
||||
|
||||
-- quick method to see if two trees have common elements
|
||||
-- | quick method to see if two trees have common elements
|
||||
--
|
||||
-- the complexity is O(log |old|, |new|) so the heuristic is that new is smaller
|
||||
|
||||
commonsInTree :: (Ord a) => BinTree (a,b) -> BinTree (a,b) -> [(a,(b,b))]
|
||||
commonsInTree old new = foldr inOld [] new' where
|
||||
new' = tree2list new
|
||||
@@ -266,13 +324,11 @@ lookupTreeMany pr (t:ts) x = case lookupTree pr x t of
|
||||
_ -> lookupTreeMany pr ts x
|
||||
lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr x
|
||||
|
||||
-- destructive update
|
||||
|
||||
-- | destructive update
|
||||
updateTree :: (Ord a) => (a,b) -> BinTree (a,b) -> BinTree (a,b)
|
||||
updateTree = updateTreeGen True
|
||||
|
||||
-- destructive or not
|
||||
|
||||
-- | destructive or not
|
||||
updateTreeGen :: (Ord a) => Bool -> (a,b) -> BinTree (a,b) -> BinTree (a,b)
|
||||
updateTreeGen destr z@(x,y) tree = case tree of
|
||||
NT -> BT z NT NT
|
||||
@@ -419,8 +475,7 @@ prIfEmpty :: String -> String -> String -> String -> String
|
||||
prIfEmpty em _ _ [] = em
|
||||
prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2
|
||||
|
||||
-- Thomas Hallgren's wrap lines
|
||||
--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
|
||||
-- | Thomas Hallgren's wrap lines
|
||||
wrapLines n "" = ""
|
||||
wrapLines n s@(c:cs) =
|
||||
if isSpace c
|
||||
@@ -433,6 +488,8 @@ wrapLines n s@(c:cs) =
|
||||
l = length w
|
||||
_ -> s -- give up!!
|
||||
|
||||
--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
|
||||
|
||||
-- LaTeX code producing functions
|
||||
|
||||
dollar s = '$' : s ++ "$"
|
||||
@@ -468,8 +525,8 @@ sortByLongest = sortBy longer where
|
||||
x' = length x
|
||||
y' = length y
|
||||
|
||||
-- "combinations" is the same as "sequence"!!!
|
||||
-- peb 30/5-04
|
||||
-- | 'combinations' is the same as @sequence@!!!
|
||||
-- peb 30\/5-04
|
||||
combinations :: [[a]] -> [[a]]
|
||||
combinations t = case t of
|
||||
[] -> [[]]
|
||||
@@ -527,8 +584,7 @@ topoSort g = reverse $ tsort 0 [ffs | ffs@(f,_) <- g, inDeg f == 0] [] where
|
||||
inDeg f = length [t | (h,hs) <- g, t <- hs, t == f]
|
||||
lx = length g
|
||||
|
||||
-- the generic fix point iterator
|
||||
|
||||
-- | the generic fix point iterator
|
||||
iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
|
||||
iterFix more start = iter start start
|
||||
where
|
||||
@@ -549,8 +605,7 @@ updateAssoc ab@(a,b) as = case as of
|
||||
removeAssoc :: Eq a => a -> [(a,b)] -> [(a,b)]
|
||||
removeAssoc a = filter ((/=a) . fst)
|
||||
|
||||
-- chop into separator-separated parts
|
||||
|
||||
-- | chop into separator-separated parts
|
||||
chunks :: String -> [String] -> [[String]]
|
||||
chunks sep ws = case span (/= sep) ws of
|
||||
(a,_:b) -> a : bs where bs = chunks sep b
|
||||
@@ -608,7 +663,8 @@ instance ErrorMonad (STM s) where
|
||||
handle (STM f) g = STM (\s -> (f s)
|
||||
`handle` (\e -> let STM g' = (g e) in
|
||||
g' s))
|
||||
-- if the first check fails try another one
|
||||
|
||||
-- | if the first check fails try another one
|
||||
checkAgain :: ErrorMonad m => m a -> m a -> m a
|
||||
checkAgain c1 c2 = handle_ c1 c2
|
||||
|
||||
|
||||
@@ -5,16 +5,16 @@
|
||||
-- Stability : Obsolete
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- The class of finite maps, as described in
|
||||
-- "Pure Functional Parsing", section 2.2.2
|
||||
-- \"Pure Functional Parsing\", section 2.2.2
|
||||
-- and an example implementation,
|
||||
-- derived from appendix A.2
|
||||
--
|
||||
-- /OBSOLETE/! this is only used in cf\/ChartParser.hs
|
||||
-- /OBSOLETE/! this is only used in module "ChartParser"
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module OrdMap2 (OrdMap(..), Map) where
|
||||
|
||||
@@ -5,16 +5,16 @@
|
||||
-- Stability : Obsolete
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- The class of ordered sets, as described in
|
||||
-- "Pure Functional Parsing", section 2.2.1,
|
||||
-- \"Pure Functional Parsing\", section 2.2.1,
|
||||
-- and an example implementation
|
||||
-- derived from appendix A.1
|
||||
--
|
||||
-- /OBSOLETE/! this is only used in cf\/ChartParser.hs
|
||||
-- /OBSOLETE/! this is only used in module "ChartParser"
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module OrdSet (OrdSet(..), Set) where
|
||||
|
||||
@@ -5,16 +5,31 @@
|
||||
-- Stability : Almost Obsolete
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- some parser combinators a` la Wadler and Hutton
|
||||
-- some parser combinators a la Wadler and Hutton.
|
||||
-- no longer used in many places in GF
|
||||
-- (only used in EBNF.hs)
|
||||
-- (only used in module "EBNF")
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Parsers where
|
||||
module Parsers (-- * Main types and functions
|
||||
Parser, parseResults, parseResultErr,
|
||||
-- * Basic combinators (on any token type)
|
||||
(...), (.>.), (|||), (+||), literal, (***),
|
||||
succeed, fails, (+..), (..+), (<<<), (|>),
|
||||
many, some, longestOfMany, longestOfSome,
|
||||
closure,
|
||||
-- * Specific combinators (for @Char@ token type)
|
||||
pJunk, pJ, jL, pTList, pTJList, pElem,
|
||||
(....), item, satisfy, literals, lits,
|
||||
pParenth, pCommaList, pOptCommaList,
|
||||
pArgList, pArgList2,
|
||||
pIdent, pLetter, pDigit, pLetters,
|
||||
pAlphanum, pAlphaPlusChar,
|
||||
pQuotedString, pIntc
|
||||
) where
|
||||
|
||||
import Operations
|
||||
import Char
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- Modified version of Osanaki's implementation.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -1,16 +1,3 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module SharedString (shareString) where
|
||||
|
||||
|
||||
@@ -1,13 +1,13 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Str
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -23,23 +23,23 @@ module Str (
|
||||
import Operations
|
||||
import List (isPrefixOf, isSuffixOf, intersperse)
|
||||
|
||||
-- abstract token list type. AR 2001, revised and simplified 20/4/2003
|
||||
|
||||
-- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003
|
||||
newtype Str = Str [Tok] deriving (Read, Show, Eq, Ord)
|
||||
|
||||
data Tok =
|
||||
TK String
|
||||
| TN Ss [(Ss, [String])] -- variants depending on next 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"}
|
||||
-- ^ 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
|
||||
-- i.e. not itself containing variants
|
||||
|
||||
-- | a variant can itself be a token list, but for simplicity only a list of strings
|
||||
-- i.e. not itself containing variants
|
||||
type Ss = [String]
|
||||
|
||||
-- matching functions in both ways
|
||||
@@ -80,8 +80,7 @@ str2allStrings (Str st) = alls st where
|
||||
sstr :: Str -> String
|
||||
sstr = unwords . str2strings
|
||||
|
||||
-- to handle a list of variants
|
||||
|
||||
-- | to handle a list of variants
|
||||
sstrV :: [Str] -> String
|
||||
sstrV ss = case ss of
|
||||
[] -> "*"
|
||||
@@ -127,8 +126,7 @@ glues ss tt = case (ss,tt) of
|
||||
(_,[]) -> ss
|
||||
_ -> init ss ++ [last ss ++ head tt] ++ tail tt
|
||||
|
||||
-- to create the list of all lexical items
|
||||
|
||||
-- | to create the list of all lexical items
|
||||
allItems :: Str -> [String]
|
||||
allItems (Str s) = concatMap allOne s where
|
||||
allOne t = case t of
|
||||
|
||||
@@ -2,12 +2,12 @@
|
||||
-- |
|
||||
-- Module : Trie
|
||||
-- Maintainer : Markus Forsberg
|
||||
-- Stability : Obsolete???
|
||||
-- Stability : Obsolete
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Haskell 98
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -1,18 +1,57 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Zipper
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
--
|
||||
-- Gérard Huet's zipper (JFP 7 (1997)). AR 10/8/2001
|
||||
-- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Zipper where
|
||||
module Zipper (-- * types
|
||||
Tr(..),
|
||||
Path(..),
|
||||
Loc(..),
|
||||
-- * basic (original) functions
|
||||
leaf,
|
||||
goLeft, goRight, goUp, goDown,
|
||||
changeLoc,
|
||||
changeNode,
|
||||
forgetNode,
|
||||
-- * added sequential representation
|
||||
goAhead,
|
||||
goBack,
|
||||
-- ** n-ary versions
|
||||
goAheadN,
|
||||
goBackN,
|
||||
-- * added mappings between locations and trees
|
||||
loc2tree,
|
||||
loc2treeMarked,
|
||||
tree2loc,
|
||||
goRoot,
|
||||
goLast,
|
||||
goPosition,
|
||||
-- * added some utilities
|
||||
traverseCollect,
|
||||
scanTree,
|
||||
mapTr,
|
||||
mapTrM,
|
||||
mapPath,
|
||||
mapPathM,
|
||||
mapLoc,
|
||||
mapLocM,
|
||||
foldTr,
|
||||
foldTrM,
|
||||
mapSubtrees,
|
||||
mapSubtreesM,
|
||||
changeRoot,
|
||||
nthSubtree,
|
||||
arityTree
|
||||
) where
|
||||
|
||||
import Operations
|
||||
|
||||
@@ -56,7 +95,7 @@ forgetNode _ = Bad $ "not a one-branch tree"
|
||||
|
||||
-- added sequential representation
|
||||
|
||||
-- a successor function
|
||||
-- | a successor function
|
||||
goAhead :: Loc a -> Err (Loc a)
|
||||
goAhead s@(Loc (t,p)) = case (t,p) of
|
||||
(Tr (_,_:_),Node (_,_,_:_)) -> goDown s
|
||||
@@ -67,7 +106,7 @@ goAhead s@(Loc (t,p)) = case (t,p) of
|
||||
Ok t' -> return t'
|
||||
Bad _ -> goUp t >>= upsRight
|
||||
|
||||
-- a predecessor function
|
||||
-- | a predecessor function
|
||||
goBack :: Loc a -> Err (Loc a)
|
||||
goBack s@(Loc (t,p)) = case goLeft s of
|
||||
Ok s' -> downRight s'
|
||||
@@ -183,7 +222,7 @@ mapSubtreesM f t = do
|
||||
ts' <- mapM (mapSubtreesM f) ts
|
||||
return $ Tr (x, ts')
|
||||
|
||||
-- change the root without moving the pointer
|
||||
-- | change the root without moving the pointer
|
||||
changeRoot :: (a -> a) -> Loc a -> Loc a
|
||||
changeRoot f loc = case loc of
|
||||
Loc (Tr (a,ts),Top) -> Loc (Tr (f a,ts),Top)
|
||||
@@ -197,4 +236,4 @@ nthSubtree :: Int -> Tr a -> Err (Tr a)
|
||||
nthSubtree n (Tr (a,ts)) = ts !? n
|
||||
|
||||
arityTree :: Tr a -> Int
|
||||
arityTree (Tr (_,ts)) = length ts
|
||||
arityTree (Tr (_,ts)) = length ts
|
||||
|
||||
Reference in New Issue
Block a user