From 71c316cfc5312ecd309ba36bae72e3420a7f5c1c Mon Sep 17 00:00:00 2001 From: peb Date: Wed, 9 Feb 2005 11:46:54 +0000 Subject: [PATCH] "Committed_by_peb" --- src/GF/API.hs | 18 +-- src/GF/API/BatchTranslate.hs | 6 +- src/GF/API/GrammarToHaskell.hs | 12 +- src/GF/API/IOGrammar.hs | 6 +- src/GF/API/MyParser.hs | 6 +- src/GF/CF/CF.hs | 32 ++-- src/GF/CF/CFIdent.hs | 37 +++-- src/GF/CF/CFtoGrammar.hs | 6 +- src/GF/CF/CFtoSRG.hs | 27 +--- src/GF/CF/CanonToCF.hs | 27 ++-- src/GF/CF/ChartParser.hs | 20 +-- src/GF/CF/EBNF.hs | 2 +- src/GF/CF/PPrCF.hs | 9 +- src/GF/CF/PrLBNF.hs | 16 +- src/GF/CF/Profile.hs | 20 +-- src/GF/Canon/CMacros.hs | 30 ++-- src/GF/Canon/CanonToGrammar.hs | 6 +- src/GF/Canon/GFC.hs | 6 +- src/GF/Canon/GetGFC.hs | 2 +- src/GF/Canon/Look.hs | 4 +- src/GF/Canon/MkGFC.hs | 5 +- src/GF/Canon/PrExp.hs | 8 +- src/GF/Canon/Share.hs | 20 ++- src/GF/Canon/Unlex.hs | 8 +- src/GF/Compile/Compile.hs | 4 +- src/GF/Compile/PrOld.hs | 10 +- src/GF/Data/ErrM.hs | 3 +- src/GF/Data/Glue.hs | 6 +- src/GF/Data/Map.hs | 18 +-- src/GF/Data/OrdMap2.hs | 28 ++-- src/GF/Data/OrdSet.hs | 28 ++-- src/GF/Data/Parsers.hs | 14 +- src/GF/Data/RedBlack.hs | 20 +-- src/GF/Data/Trie.hs | 18 +-- src/GF/Data/Trie2.hs | 14 +- src/GF/Data/Zipper.hs | 4 +- src/GF/Infra/CheckM.hs | 4 +- src/GF/Infra/Comments.hs | 5 +- src/GF/Infra/Ident.hs | 19 ++- src/GF/Text/Arabic.hs | 2 +- src/GF/Text/Devanagari.hs | 2 +- src/GF/Text/Ethiopic.hs | 2 +- src/GF/Text/ExtendedArabic.hs | 2 +- src/GF/Text/ExtraDiacritics.hs | 2 +- src/GF/Text/Greek.hs | 2 +- src/GF/Text/Hebrew.hs | 2 +- src/GF/Text/Hiragana.hs | 2 +- src/GF/Text/LatinASupplement.hs | 2 +- src/GF/Text/OCSCyrillic.hs | 2 +- src/GF/Text/Russian.hs | 2 +- src/GF/Text/Tamil.hs | 2 +- src/GF/Text/UTF8.hs | 2 +- src/GF/Text/Unicode.hs | 11 +- src/module-structure.txt | 253 ++++++++++++++++++++++++++++++++ src/tools/mktoday.sh | 6 +- 55 files changed, 485 insertions(+), 339 deletions(-) create mode 100644 src/module-structure.txt diff --git a/src/GF/API.hs b/src/GF/API.hs index b07678ddd..cc3a8c206 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -1,7 +1,7 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) +-- Module : API +-- Maintainer : Aarne Ranta -- Stability : (stable) -- Portability : (portable) -- @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001 ----------------------------------------------------------------------------- module API where @@ -72,8 +72,6 @@ import List (nub) import Monad (liftM) import System (system) --- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001 - type GFGrammar = StateGrammar type GFCat = CFCat type Ident = I.Ident @@ -279,7 +277,7 @@ optParseArgErrMsg opts gr s = do _ -> return ts return (ts',m) --- analyses word by word +-- | analyses word by word morphoAnalyse :: Options -> GFGrammar -> String -> String morphoAnalyse opts gr | oElem beShort opts = morphoTextShort mo @@ -318,7 +316,7 @@ optPrintSyntax opts = customOrDefault opts grammarPrinter customSyntaxPrinter optPrintTree :: Options -> GFGrammar -> Tree -> String optPrintTree opts = customOrDefault opts grammarPrinter customTermPrinter --- look for string command (-filter=x) +-- | look for string command (-filter=x) optStringCommand :: Options -> GFGrammar -> String -> String optStringCommand opts g = optIntOrAll opts flagLength . @@ -352,19 +350,19 @@ optTokenizer opts gr = show . customOrDefault opts useTokenizer customTokenizer -- performs UTF8 if the language does not have flag coding=utf8; replaces name*U --- convert a Unicode string into a UTF8 encoded string +-- | convert a Unicode string into a UTF8 encoded string optEncodeUTF8 :: GFGrammar -> String -> String optEncodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of Just "utf8" -> id _ -> encodeUTF8 --- convert a UTF8 encoded string into a Unicode string +-- | convert a UTF8 encoded string into a Unicode string optDecodeUTF8 :: GFGrammar -> String -> String optDecodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of Just "utf8" -> decodeUTF8 _ -> id --- convert a string encoded with some coding given by the coding flag to UTF8 +-- | convert a string encoded with some coding given by the coding flag to UTF8 anyCodingToUTF8 :: Options -> String -> String anyCodingToUTF8 opts = encodeUTF8 . customOrDefault opts uniCoding customUniCoding diff --git a/src/GF/API/BatchTranslate.hs b/src/GF/API/BatchTranslate.hs index 5726e6739..88a10a2af 100644 --- a/src/GF/API/BatchTranslate.hs +++ b/src/GF/API/BatchTranslate.hs @@ -9,16 +9,14 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- translate OCL, etc, files in batch mode ----------------------------------------------------------------------------- -module BatchTranslate where +module BatchTranslate (translate) where import API import GetMyTree (file2tree) --- translate OCL, etc, files in batch mode - translate :: FilePath -> FilePath -> IO () translate fgr txt = do gr <- file2grammar fgr diff --git a/src/GF/API/GrammarToHaskell.hs b/src/GF/API/GrammarToHaskell.hs index 081d533e3..61e720dd1 100644 --- a/src/GF/API/GrammarToHaskell.hs +++ b/src/GF/API/GrammarToHaskell.hs @@ -9,7 +9,9 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- to write a GF abstract grammar into a Haskell module with translations from +-- data objects into GF trees. Example: GSyntax for Agda. +-- AR 11/11/1999 -- 7/12/2000 -- 18/5/2004 ----------------------------------------------------------------------------- module GrammarToHaskell (grammar2haskell) where @@ -20,17 +22,13 @@ import Macros import Modules import Operations --- to write a GF abstract grammar into a Haskell module with translations from --- data objects into GF trees. Example: GSyntax for Agda. --- AR 11/11/1999 -- 7/12/2000 -- 18/5/2004 - --- the main function +-- | the main function grammar2haskell :: GFC.CanonGrammar -> String grammar2haskell gr = foldr (++++) [] $ haskPreamble ++ [datatypes gr', gfinstances gr', fginstances gr'] where gr' = hSkeleton gr --- by this you can prefix all identifiers with stg; the default is 'G' +-- | by this you can prefix all identifiers with stg; the default is 'G' gId :: OIdent -> OIdent gId i = 'G':i diff --git a/src/GF/API/IOGrammar.hs b/src/GF/API/IOGrammar.hs index b74facd4e..5a12e6b42 100644 --- a/src/GF/API/IOGrammar.hs +++ b/src/GF/API/IOGrammar.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- for reading grammars and terms from strings and files ----------------------------------------------------------------------------- module IOGrammar where @@ -30,9 +30,7 @@ import Arch import Monad (liftM) --- for reading grammars and terms from strings and files - ---- a heuristic way of renaming constants is used +-- | a heuristic way of renaming constants is used string2absTerm :: String -> String -> Term string2absTerm m = renameTermIn m . pTrm diff --git a/src/GF/API/MyParser.hs b/src/GF/API/MyParser.hs index 60f5541ce..c45f30c3d 100644 --- a/src/GF/API/MyParser.hs +++ b/src/GF/API/MyParser.hs @@ -9,18 +9,16 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- template to define your own parser ----------------------------------------------------------------------------- -module MyParser where +module MyParser (myParser) where import ShellState import CFIdent import CF import Operations --- template to define your own parser - -- type CFParser = [CFTok] -> ([(CFTree,[CFTok])],String) myParser :: StateGrammar -> CFCat -> CFParser diff --git a/src/GF/CF/CF.hs b/src/GF/CF/CF.hs index 525ed2100..962a7d8c7 100644 --- a/src/GF/CF/CF.hs +++ b/src/GF/CF/CF.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- context-free grammars. AR 15/12/1999 -- 30/3/2000 -- 2/6/2001 -- 3/12/2001 ----------------------------------------------------------------------------- module CF where @@ -22,34 +22,33 @@ import CFIdent import List (nub,nubBy) import Char (isUpper, isLower, toUpper, toLower) --- context-free grammars. AR 15/12/1999 -- 30/3/2000 -- 2/6/2001 -- 3/12/2001 - -- CF grammar data types --- abstract type CF. +-- | abstract type CF. -- Invariant: each category has all its rules grouped with it -- also: the list is never empty (the category is just missing then) newtype CF = CF ([CFRuleGroup], CFPredef) type CFRule = (CFFun, (CFCat, [CFItem])) type CFRuleGroup = (CFCat,[CFRule]) --- CFPredef is a hack for variable symbols and literals; normally = const [] +-- | CFPredef is a hack for variable symbols and literals; normally = @const []@ data CFItem = CFTerm RegExp | CFNonterm CFCat deriving (Eq, Ord,Show) newtype CFTree = CFTree (CFFun,(CFCat, [CFTree])) deriving (Eq, Show) -type CFPredef = CFTok -> [(CFCat, CFFun)] -- recognize literals, variables, etc +-- | recognize literals, variables, etc +type CFPredef = CFTok -> [(CFCat, CFFun)] --- Wadler style + return information +-- | Wadler style + return information type CFParser = [CFTok] -> ([(CFTree,[CFTok])],String) cfParseResults :: ([(CFTree,[CFTok])],String) -> [CFTree] cfParseResults rs = [b | (b,[]) <- fst rs] --- terminals are regular expressions on words; to be completed to full regexp +-- | terminals are regular expressions on words; to be completed to full regexp data RegExp = - RegAlts [CFWord] -- list of alternative words - | RegSpec CFTok -- special token + RegAlts [CFWord] -- ^ list of alternative words + | RegSpec CFTok -- ^ special token deriving (Eq, Ord, Show) type CFWord = String @@ -78,11 +77,11 @@ groupCFRules = foldr ins [] where -- to construct rules --- make a rule from a single token without constituents +-- | make a rule from a single token without constituents atomCFRule :: CFCat -> CFFun -> CFTok -> CFRule atomCFRule c f s = (f, (c, [atomCFTerm s])) --- usual terminal +-- | usual terminal atomCFTerm :: CFTok -> CFItem atomCFTerm = CFTerm . atomRegExp @@ -91,18 +90,18 @@ atomRegExp t = case t of TS s -> RegAlts [s] _ -> RegSpec t --- terminal consisting of alternatives +-- | terminal consisting of alternatives altsCFTerm :: [String] -> CFItem altsCFTerm = CFTerm . RegAlts -- to construct trees --- make a tree without constituents +-- | make a tree without constituents atomCFTree :: CFCat -> CFFun -> CFTree atomCFTree c f = buildCFTree c f [] --- make a tree with constituents. +-- | make a tree with constituents. buildCFTree :: CFCat -> CFFun -> [CFTree] -> CFTree buildCFTree c f trees = CFTree (f,(c,trees)) @@ -188,8 +187,7 @@ isCircularCF (_,(c', CFNonterm c:[])) = compatCF c' c isCircularCF _ = False --- we should make a test of circular chains, too --- coercion to the older predef cf type - +-- | coercion to the older predef cf type predefRules :: CFPredef -> CFTok -> [CFRule] predefRules pre s = [atomCFRule c f s | (c,f) <- pre s] diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs index ab93c7389..11748203a 100644 --- a/src/GF/CF/CFIdent.hs +++ b/src/GF/CF/CFIdent.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- symbols (categories, functions) for context-free grammars. ----------------------------------------------------------------------------- module CFIdent where @@ -24,19 +24,17 @@ import PrGrammar import Str import Char (toLower, toUpper) --- symbols (categories, functions) for context-free grammars. - --- these types should be abstract - +-- this type should be abstract data CFTok = - TS String -- normal strings - | TC String -- strings that are ambiguous between upper or lower case - | TL String -- string literals - | TI Int -- integer literals - | TV Ident -- variables - | TM Int String -- metavariables; the integer identifies it + TS String -- ^ normal strings + | TC String -- ^ strings that are ambiguous between upper or lower case + | TL String -- ^ string literals + | TI Int -- ^ integer literals + | TV Ident -- ^ variables + | TM Int String -- ^ metavariables; the integer identifies it deriving (Eq, Ord, Show) +-- | this type should be abstract newtype CFCat = CFCat (CIdent,Label) deriving (Eq, Ord, Show) tS, tC, tL, tI, tV, tM :: String -> CFTok @@ -59,7 +57,7 @@ prCFTok t = case t of TV x -> prt x TM i m -> m --- "?" --- m --- to build trees: the Atom contains a GF function, Cn | Meta | Vr | Literal +-- | to build trees: the Atom contains a GF function, @Cn | Meta | Vr | Literal@ newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Ord,Show) -- - - - - - - - - - - - - - - - - - - - - ^^^ added by peb, 21/5-04 @@ -83,7 +81,7 @@ varCFFun = mkCFFun . AV consCFFun :: CIdent -> CFFun consCFFun = mkCFFun . AC --- standard way of making cf fun +-- | standard way of making cf fun string2CFFun :: String -> String -> CFFun string2CFFun m c = consCFFun $ mkCIdent m c @@ -115,14 +113,14 @@ metaCFFun = mkCFFun $ AM 0 -- to construct CF categories --- belongs elsewhere +-- | belongs elsewhere mkCIdent :: String -> String -> CIdent mkCIdent m c = CIQ (identC m) (identC c) ident2CFCat :: CIdent -> Ident -> CFCat ident2CFCat mc d = CFCat (mc, L d) --- standard way of making cf cat: label s +-- | standard way of making cf cat: label s string2CFCat :: String -> String -> CFCat string2CFCat m c = ident2CFCat (mkCIdent m c) (identC "s") @@ -135,7 +133,7 @@ catVarCF = ident2CFCat (mkCIdent "_" "#Var") (identC "_") ---- cat2CFCat :: (Ident,Ident) -> CFCat cat2CFCat = uncurry idents2CFCat ----- literals +-- | literals cfCatString = string2CFCat (prt cPredefAbs) "String" cfCatInt = string2CFCat (prt cPredefAbs) "Int" @@ -149,7 +147,7 @@ uCFCat = cat2CFCat uCat moduleOfCFCat :: CFCat -> Ident moduleOfCFCat (CFCat (CIQ m _, _)) = m --- the opposite direction +-- | the opposite direction cfCat2Cat :: CFCat -> (Ident,Ident) cfCat2Cat (CFCat (CIQ m c,_)) = (m,c) @@ -179,12 +177,11 @@ compatTok t u = any (`elem` (alts t)) (alts u) where TC (c:s) -> [toLower c : s, toUpper c : s] _ -> [prCFTok u] --- decide if two CFFuns have the same function head (profiles may differ) - +-- | decide if two CFFuns have the same function head (profiles may differ) compatCFFun :: CFFun -> CFFun -> Bool compatCFFun (CFFun (f,_)) (CFFun (g,_)) = f == g --- decide whether two categories match +-- | decide whether two categories match -- the modifiers can be from different modules, but on the same extension -- path, so there is no clash, and they can be safely ignored --- compatCF :: CFCat -> CFCat -> Bool diff --git a/src/GF/CF/CFtoGrammar.hs b/src/GF/CF/CFtoGrammar.hs index 8dcc66759..14f11b52c 100644 --- a/src/GF/CF/CFtoGrammar.hs +++ b/src/GF/CF/CFtoGrammar.hs @@ -9,10 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- 26\/1\/2000 -- 18\/4 -- 24\/3\/2004 ----------------------------------------------------------------------------- -module CFtoGrammar where +module CFtoGrammar (cf2grammar) where import Ident import Grammar @@ -29,8 +29,6 @@ import Operations import List (nub) import Char (isSpace) --- 26/1/2000 -- 18/4 -- 24/3/2004 - cf2grammar :: CF -> [A.TopDef] cf2grammar cf = concatMap S.trAnyDef (abs ++ conc) where rules = rulesOfCF cf diff --git a/src/GF/CF/CFtoSRG.hs b/src/GF/CF/CFtoSRG.hs index 4437417e8..f8c7bddd5 100644 --- a/src/GF/CF/CFtoSRG.hs +++ b/src/GF/CF/CFtoSRG.hs @@ -1,7 +1,7 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) +-- Module : CFtoSRG +-- Maintainer : Markus Forsberg -- Stability : (stable) -- Portability : (portable) -- @@ -9,27 +9,12 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- This module prints a CF as a SRG (Speech Recognition Grammar). +-- Created : 21 January, 2001. +-- Modified : 16 April, 2004 by Aarne Ranta for GF 2. ----------------------------------------------------------------------------- -{- - ************************************************************** - GF Module - - Description : This module prints a CF as a SRG (Speech - Recognition Grammar). - - Author : Markus Forsberg (markus@cs.chalmers.se) - - License : GPL (GNU General Public License) - - Created : 21 January, 2001 - - Modified : 16 April, 2004 by Aarne Ranta for GF 2 - ************************************************************** --} - -module CFtoSRG where +module CFtoSRG (prSRG) where import Operations import CF diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs index a343a2473..41306c002 100644 --- a/src/GF/CF/CanonToCF.hs +++ b/src/GF/CF/CanonToCF.hs @@ -9,10 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003 ----------------------------------------------------------------------------- -module CanonToCF where +module CanonToCF (canon2cf) where import Tracing -- peb 8/6-04 @@ -33,12 +33,9 @@ import Trie2 import List (nub,partition) import Monad --- AR 27/1/2000 -- 3/12/2001 -- 8/6/2003 - --- The main function: for a given cnc module m, build the CF grammar with all the --- rules coming from modules that m extends. The categories are qualified by --- the abstract module name a that m is of. - +-- | The main function: for a given cnc module 'm', build the CF grammar with all the +-- rules coming from modules that 'm' extends. The categories are qualified by +-- the abstract module name 'a' that 'm' is of. canon2cf :: Options -> CanonGrammar -> Ident -> Err CF canon2cf opts gr c = tracePrt "#size of CF" (err id (show.length.rulesOfCF)) $ do -- peb 8/6-04 let ms = M.allExtends gr c @@ -60,20 +57,20 @@ cnc2cfCond opts m gr = type IFun = Ident type ICat = CIdent --- all CF rules corresponding to a linearization rule +-- | all CF rules corresponding to a linearization rule lin2cf :: (Ident, IFun, ICat, [ArgVar], Term) -> Err [CFRule] lin2cf (m,fun,cat,args,lin) = errIn ("building CF rule for" +++ prt fun) $ do rhss0 <- allLinValues lin -- :: [(Label, [([Patt],Term)])] rhss1 <- mapM (mkCFItems m) (concat rhss0) -- :: [(Label, [[PreCFItem]])] mapM (mkCfRules m fun cat args) rhss1 >>= return . nub . concat --- making sequences of CF items from every branch in a linearization +-- | making sequences of CF items from every branch in a linearization mkCFItems :: Ident -> (Label, [([Patt],Term)]) -> Err (Label, [[PreCFItem]]) mkCFItems m (lab,pts) = do itemss <- mapM (term2CFItems m) (map snd pts) return (lab, concat itemss) ---- combinations? (test!) --- making CF rules from sequences of CF items +-- | making CF rules from sequences of CF items mkCfRules :: Ident -> IFun -> ICat -> [ArgVar] -> (Label, [[PreCFItem]]) -> Err [CFRule] mkCfRules m fun cat args (lab, itss) = mapM mkOneRule itss where @@ -91,10 +88,10 @@ mkCfRules m fun cat args (lab, itss) = mapM mkOneRule itss where mkB x = [k | (k,(j, LV y,False)) <- nonterms, j == i, y == x] --- intermediate data structure of CFItems with information for profiles +-- | intermediate data structure of CFItems with information for profiles data PreCFItem = - PTerm RegExp -- like ordinary Terminal - | PNonterm CIdent Integer Label Bool -- cat, position, part/bind, whether arg + PTerm RegExp -- ^ like ordinary Terminal + | PNonterm CIdent Integer Label Bool -- ^ cat, position, part\/bind, whether arg deriving Eq precf2cf :: PreCFItem -> CFItem @@ -103,7 +100,7 @@ precf2cf (PNonterm cm _ (L c) True) = CFNonterm (ident2CFCat cm c) precf2cf (PNonterm _ _ _ False) = CFNonterm catVarCF --- the main job in translating linearization rules into sequences of cf items +-- | the main job in translating linearization rules into sequences of cf items term2CFItems :: Ident -> Term -> Err [[PreCFItem]] term2CFItems m t = errIn "forming cf items" $ case t of S c _ -> t2c c diff --git a/src/GF/CF/ChartParser.hs b/src/GF/CF/ChartParser.hs index 26b2f31bd..4b2f2ceb1 100644 --- a/src/GF/CF/ChartParser.hs +++ b/src/GF/CF/ChartParser.hs @@ -1,7 +1,7 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) +-- Module : ChartParser +-- Maintainer : Peter Ljunglöf -- Stability : (stable) -- Portability : (portable) -- @@ -9,22 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Bottom-up Kilbury chart parser from "Pure Functional Parsing", chapter 5. +-- OBSOLETE -- should use new MCFG parsers instead ----------------------------------------------------------------------------- -{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Filename: ChartParser.hs - Author: Peter Ljunglöf - Time-stamp: <2004-05-25 02:20:01 peb> - - Description: Bottom-up Kilbury chart parser from - "Pure Functional Parsing", chapter 5 - - DESIRED CHANGES: - The modules OrdSet and OrdMap2 are obsolete - and should be changed to newer versions - - Also, should use the CFG parsers in parsing/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} - module ChartParser (chartParser) where import Tracing diff --git a/src/GF/CF/EBNF.hs b/src/GF/CF/EBNF.hs index 99d5f8b30..bf54c59c2 100644 --- a/src/GF/CF/EBNF.hs +++ b/src/GF/CF/EBNF.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module EBNF where +module EBNF (pEBNFasGrammar) where import Operations import Parsers diff --git a/src/GF/CF/PPrCF.hs b/src/GF/CF/PPrCF.hs index 53e59270f..11a710986 100644 --- a/src/GF/CF/PPrCF.hs +++ b/src/GF/CF/PPrCF.hs @@ -9,10 +9,12 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003 +-- +-- use the Print class instead! ----------------------------------------------------------------------------- -module PPrCF where +module PPrCF (prCF, prCFTree, prCFRule, prCFFun, prCFCat, prCFItem, prRegExp, pCF) where import Operations import CF @@ -22,9 +24,6 @@ import PrGrammar import Char --- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003 ----- use the Print class instead! - prCF :: CF -> String prCF = unlines . (map prCFRule) . rulesOfCF -- hiding the literal recogn function diff --git a/src/GF/CF/PrLBNF.hs b/src/GF/CF/PrLBNF.hs index 8b509fe7b..b86609a70 100644 --- a/src/GF/CF/PrLBNF.hs +++ b/src/GF/CF/PrLBNF.hs @@ -9,7 +9,9 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Printing CF grammars generated from GF as LBNF grammar for BNFC. +-- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004. +-- With primitive error messaging, by rules and rule tails commented out ----------------------------------------------------------------------------- module PrLBNF (prLBNF,prBNF) where @@ -29,10 +31,6 @@ import Modules import Char import List (nub) --- Printing CF grammars generated from GF as LBNF grammar for BNFC. --- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004 --- With primitive error messaging, by rules and rule tails commented out - prLBNF :: Bool -> StateGrammar -> String prLBNF new gr = unlines $ pragmas ++ (map (prCFRule cs) rules) where @@ -42,7 +40,7 @@ prLBNF new gr = unlines $ pragmas ++ (map (prCFRule cs) rules) then mkLBNF (stateGrammarST gr) $ rulesOfCF cf else ([],rulesOfCF cf) -- "normal" behaviour --- a hack to hide the LBNF details +-- | a hack to hide the LBNF details prBNF :: Bool -> StateGrammar -> String prBNF b = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF b where @@ -52,7 +50,7 @@ prBNF b = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF b c:ts -> c : unLBNF ts _ -> r ---- awful low level code without abstraction over label names etc +--- | awful low level code without abstraction over label names etc mkLBNF :: CanonGrammar -> [CFRule] -> ([String],[CFRule]) mkLBNF gr rules = (coercions, nub $ concatMap mkRule rules) where coercions = ["coercions" +++ prt_ c +++ show n +++ ";" | @@ -129,7 +127,7 @@ prLab i = case i of L (IC "_") -> "" --- _ -> let x = prt i in "_" ++ x ++ if isDigit (last x) then "_" else "" --- just comment out the rest if you cannot interpret the function name in LBNF +-- | just comment out the rest if you cannot interpret the function name in LBNF -- two versions, depending on whether in the beginning of a rule or elsewhere; -- in the latter case, error just terminates the rule prErr :: Bool -> String -> String @@ -138,7 +136,7 @@ prErr b s = (if b then "" else " ;") +++ "---" +++ s prCFCat :: Bool -> CFCat -> String prCFCat b (CFCat ((CIQ _ c),l)) = prId b c ++ prLab l ---- --- if a category does not have a production of its own, we replace it by Ident +-- | if a category does not have a production of its own, we replace it by Ident prCFItem cs (CFNonterm c) = if elem (catIdPlus c) cs then prCFCat False c else "Ident" prCFItem _ (CFTerm a) = prRegExp a diff --git a/src/GF/CF/Profile.hs b/src/GF/CF/Profile.hs index 5d06eee6a..8d5b79777 100644 --- a/src/GF/CF/Profile.hs +++ b/src/GF/CF/Profile.hs @@ -9,7 +9,8 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001 +-- revised 8/4/2002 for the new profile structure ----------------------------------------------------------------------------- module Profile (postParse) where @@ -29,23 +30,21 @@ import Operations import Monad import List (nub) - --- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001 --- revised 8/4/2002 for the new profile structure - +-- | the job is done in two passes: +-- +-- 1. tree2term: restore constituent order from Profile +-- +-- 2. term2trm: restore Bindings from Binds postParse :: CFTree -> Err Exp postParse tree = do iterm <- errIn ("postprocessing parse tree" +++ prCFTree tree) $ tree2term tree return $ term2trm iterm --- an intermediate data structure +-- | an intermediate data structure data ITerm = ITerm (Atom, BindVs) [ITerm] | IMeta deriving (Eq,Show) type BindVs = [[I.Ident]] --- the job is done in two passes: --- (1) tree2term: restore constituent order from Profile --- (2) term2trm: restore Bindings from Binds - +-- | (1) restore constituent order from Profile tree2term :: CFTree -> Err ITerm -- tree2term (CFTree (f,(_,[t]))) | f == dummyCFFun = tree2term t -- not used tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of @@ -93,6 +92,7 @@ tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of testErr (all (==y) ys) ("fail to unify bindings of" +++ prt y) return y +-- | (2) restore Bindings from Binds term2trm :: ITerm -> Exp term2trm IMeta = EAtom (AM 0) ---- mExp0 term2trm (ITerm (fun, binds) terms) = diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs index 8c655179a..667fc0e16 100644 --- a/src/GF/Canon/CMacros.hs +++ b/src/GF/Canon/CMacros.hs @@ -29,10 +29,10 @@ import Monad -- macros for concrete syntax in GFC that do not need lookup in a grammar --- how to mark subtrees, dep. on node, position, whether focus +-- | how to mark subtrees, dep. on node, position, whether focus type JustMarker = V.TrNode -> [Int] -> Bool -> (String, String) --- also to process the text (needed for escapes e.g. in XML) +-- | also to process the text (needed for escapes e.g. in XML) type Marker = (JustMarker, Maybe (String -> String)) defTMarker :: JustMarker -> Marker @@ -44,22 +44,22 @@ markSubtree (mk,esc) n is = markSubterm esc . mk n is escapeMkString :: Marker -> Maybe (String -> String) escapeMkString = snd --- if no marking is wanted, use the following +-- | if no marking is wanted, use the following noMark :: Marker noMark = defTMarker mk where mk _ _ _ = ("","") --- for vanilla brackets, focus, and position, use +-- | for vanilla brackets, focus, and position, use markBracket :: Marker markBracket = defTMarker mk where mk n p b = if b then ("[*" ++ show p,"*]") else ("[" ++ show p,"]") --- for focus only +-- | for focus only markFocus :: Marker markFocus = defTMarker mk where mk n p b = if b then ("[*","*]") else ("","") --- for XML, use +-- | for XML, use markJustXML :: JustMarker markJustXML n i b = if b @@ -84,7 +84,7 @@ markXML = (markJustXML, Just esc) where c :cs -> c :esc cs _ -> s --- for XML in JGF 1, use +-- | for XML in JGF 1, use markXMLjgf :: Marker markXMLjgf = defTMarker mk where mk n p b = @@ -94,7 +94,7 @@ markXMLjgf = defTMarker mk where where c = "type=" ++ prt (M.valNode n) --- the marking engine +-- | the marking engine markSubterm :: Maybe (String -> String) -> (String,String) -> Term -> Term markSubterm esc (beg, end) t = case t of R rs -> R $ map markField rs @@ -181,13 +181,13 @@ strsFromTerm t = case t of _ -> return [str ("BUG[" ++ prt t ++ "]")] ---- debug ---- _ -> prtBad "cannot get Str from term " t --- recursively collect all branches in a table +-- | recursively collect all branches in a table allInTable :: Term -> [Term] allInTable t = case t of T _ ts -> concatMap (\ (Cas _ v) -> allInTable v) ts --- expand ? _ -> [t] --- to gather s-fields; assumes term in normal form, preserves label +-- | to gather s-fields; assumes term in normal form, preserves label allLinFields :: Term -> Err [[(Label,Term)]] allLinFields trm = case trm of ---- R rs -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good @@ -197,20 +197,20 @@ allLinFields trm = case trm of return $ concat lts _ -> prtBad "fields can only be sought in a record not in" trm ----- deprecated +-- | deprecated isLinLabel l = case l of L (A.IC ('s':cs)) | all isDigit cs -> True -- peb (28/4-04), for MCFG grammars to work: L (A.IC cs) | null cs || head cs `elem` ".!" -> True _ -> False --- to gather ultimate cases in a table; preserves pattern list +-- | to gather ultimate cases in a table; preserves pattern list allCaseValues :: Term -> [([Patt],Term)] allCaseValues trm = case trm of T _ cs -> [(p:ps, t) | Cas pp t0 <- cs, p <- pp, (ps,t) <- allCaseValues t0] _ -> [([],trm)] --- to gather all linearizations; assumes normal form, preserves label and args +-- | to gather all linearizations; assumes normal form, preserves label and args allLinValues :: Term -> Err [[(Label,[([Patt],Term)])]] allLinValues trm = do lts <- allLinFields trm @@ -241,8 +241,7 @@ onTokens f t = case t of _ -> composSafeOp (onTokens f) t --- to define compositional term functions - +-- | to define compositional term functions composSafeOp :: (Term -> Term) -> Term -> Term composSafeOp op trm = case composOp (mkMonadic op) trm of Ok t -> t @@ -250,6 +249,7 @@ composSafeOp op trm = case composOp (mkMonadic op) trm of where mkMonadic f = return . f +-- | to define compositional term functions composOp :: Monad m => (Term -> m Term) -> Term -> m Term composOp co trm = case trm of diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs index 16c2ae1f0..697ad2a8c 100644 --- a/src/GF/Canon/CanonToGrammar.hs +++ b/src/GF/Canon/CanonToGrammar.hs @@ -9,10 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- a decompiler. AR 12/6/2003 -- 19/4/2004 ----------------------------------------------------------------------------- -module CanonToGrammar where +module CanonToGrammar (canon2sourceGrammar, canon2sourceModule, redFlag) where import AbsGFC import GFC @@ -28,8 +28,6 @@ import Operations import Monad --- a decompiler. AR 12/6/2003 -- 19/4/2004 - canon2sourceGrammar :: CanonGrammar -> Err G.SourceGrammar canon2sourceGrammar gr = do ms' <- mapM canon2sourceModule $ M.modules gr diff --git a/src/GF/Canon/GFC.hs b/src/GF/Canon/GFC.hs index 5c6d8b6b6..81a9abc78 100644 --- a/src/GF/Canon/GFC.hs +++ b/src/GF/Canon/GFC.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9 ----------------------------------------------------------------------------- module GFC where @@ -26,8 +26,6 @@ import qualified Modules as M import Char --- canonical GF. AR 10/9/2002 -- 9/5/2003 -- 21/9 - type Context = [(Ident,Exp)] type CanonGrammar = M.MGrammar Ident Flag Info @@ -44,7 +42,7 @@ data Info = | AbsTrans A.Term | ResPar [ParDef] - | ResOper CType Term -- global constant + | ResOper CType Term -- ^ global constant | CncCat CType Term Printname | CncFun CIdent [ArgVar] Term Printname | AnyInd Bool Ident diff --git a/src/GF/Canon/GetGFC.hs b/src/GF/Canon/GetGFC.hs index cac3b98b3..e38c44a76 100644 --- a/src/GF/Canon/GetGFC.hs +++ b/src/GF/Canon/GetGFC.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module GetGFC where +module GetGFC (getCanonModule, getCanonGrammar) where import Operations import ParGFC diff --git a/src/GF/Canon/Look.hs b/src/GF/Canon/Look.hs index 43ea7a132..8c0056438 100644 --- a/src/GF/Canon/Look.hs +++ b/src/GF/Canon/Look.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- lookup in GFC. AR 2003 ----------------------------------------------------------------------------- module Look where @@ -29,8 +29,6 @@ import Option import Monad import List --- lookup in GFC. AR 2003 - -- linearization lookup lookupCncInfo :: CanonGrammar -> CIdent -> Err Info diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs index 62bb4d184..a1dfdbe2f 100644 --- a/src/GF/Canon/MkGFC.hs +++ b/src/GF/Canon/MkGFC.hs @@ -12,7 +12,10 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module MkGFC where +module MkGFC (prCanonModInfo, prCanon, prCanonMGr, + canon2grammar, grammar2canon, + info2mod, + trExp, rtExp, rtQIdent) where import GFC import AbsGFC diff --git a/src/GF/Canon/PrExp.hs b/src/GF/Canon/PrExp.hs index a689fb81a..dbd2bdc95 100644 --- a/src/GF/Canon/PrExp.hs +++ b/src/GF/Canon/PrExp.hs @@ -9,20 +9,16 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- print trees without qualifications ----------------------------------------------------------------------------- -module PrExp where +module PrExp (prExp) where import AbsGFC import GFC import Operations --- some printing - --- print trees without qualifications - prExp :: Exp -> String prExp e = case e of EApp f a -> pr1 f +++ pr2 a diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs index a5a5f5349..89323eb2f 100644 --- a/src/GF/Canon/Share.hs +++ b/src/GF/Canon/Share.hs @@ -27,11 +27,20 @@ import qualified Modules as M -- following advice of Josef Svenningsson type OptSpec = [Integer] --- + doOptFactor opt = elem 2 opt doOptValues opt = elem 3 opt + +shareOpt :: OptSpec shareOpt = [] + +paramOpt :: OptSpec paramOpt = [2] + +valOpt :: OptSpec valOpt = [3] + +allOpt :: OptSpec allOpt = [2,3] shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo) @@ -44,7 +53,7 @@ shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt c t) m) shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt c t) m) shareInfo _ i = i --- the function putting together optimizations +-- | the function putting together optimizations shareOptim :: OptSpec -> Ident -> Term -> Term shareOptim opt c | doOptFactor opt && doOptValues opt = values . factor c 0 @@ -52,9 +61,8 @@ shareOptim opt c | doOptValues opt = values | otherwise = share --- we need no counter to create new variable names, since variables are +-- | we need no counter to create new variable names, since variables are -- local to tables - share :: Term -> Term share t = case t of T ty cs -> shareT ty [(p, share v) | Cas ps v <- cs, p <- ps] -- only substant. @@ -79,8 +87,7 @@ share t = case t of finalize ty css = T ty [Cas (map fst ps) t | ps@((_,t):_) <- css] --- do even more: factor parametric branches - +-- | do even more: factor parametric branches factor :: Ident -> Int -> Term -> Term factor c i t = case t of T _ [_] -> t @@ -111,8 +118,7 @@ factor c i t = case t of pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i) --- we need to replace subterms - +-- | we need to replace subterms replace :: Term -> Term -> Term -> Term replace old new trm = case trm of T ty cs -> T ty [Cas p (repl v) | Cas p v <- cs] diff --git a/src/GF/Canon/Unlex.hs b/src/GF/Canon/Unlex.hs index 09f330e30..934fe3c43 100644 --- a/src/GF/Canon/Unlex.hs +++ b/src/GF/Canon/Unlex.hs @@ -9,10 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- elementary text postprocessing. AR 21/11/2001 ----------------------------------------------------------------------------- -module Unlex where +module Unlex (formatAsText, unlex, performBinds) where import Operations import Str @@ -20,8 +20,6 @@ import Str import Char import List (isPrefixOf) --- elementary text postprocessing. AR 21/11/2001 - formatAsText :: String -> String formatAsText = unwords . format . cap . words where format ws = case ws of @@ -40,7 +38,7 @@ formatAsText = unwords . format . cap . words where unlex :: [Str] -> String unlex = formatAsText . performBinds . concat . map sstr . take 1 ---- --- modified from GF/src/Text by adding hyphen +-- | modified from GF/src/Text by adding hyphen performBinds :: String -> String performBinds = unwords . format . words where format ws = case ws of diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index c1e006168..4c530a76c 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -5,11 +5,11 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date $ +-- > CVS $Date $ -- > CVS $Author $ -- > CVS $Revision $ -- --- The top-level compilation chain from source file to gfc/gfr. +-- The top-level compilation chain from source file to gfc\/gfr. ----------------------------------------------------------------------------- module Compile where diff --git a/src/GF/Compile/PrOld.hs b/src/GF/Compile/PrOld.hs index a6696e9a4..cba3eb536 100644 --- a/src/GF/Compile/PrOld.hs +++ b/src/GF/Compile/PrOld.hs @@ -9,7 +9,10 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- a hack to print gf2 into gf1 readable files +-- Works only for canonical grammars, printed into GFC. Otherwise we would have +-- problems with qualified names. +-- --- printnames are not preserved, nor are lindefs ----------------------------------------------------------------------------- module PrOld where @@ -28,11 +31,6 @@ import List import Operations import UseIO --- a hack to print gf2 into gf1 readable files --- Works only for canonical grammars, printed into GFC. Otherwise we would have --- problems with qualified names. ---- printnames are not preserved, nor are lindefs - printGrammarOld :: GFC.CanonGrammar -> String printGrammarOld gr = err id id $ do as0 <- mapM canon2sourceModule [im | im@(_,ModMod m) <- modules gr, isModAbs m] diff --git a/src/GF/Data/ErrM.hs b/src/GF/Data/ErrM.hs index fe9796d7f..0c0759215 100644 --- a/src/GF/Data/ErrM.hs +++ b/src/GF/Data/ErrM.hs @@ -9,7 +9,7 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- hack for BNFC generated files. AR 21/9/2003 ----------------------------------------------------------------------------- module ErrM ( @@ -18,4 +18,3 @@ module ErrM ( import Operations --- hack for BNFC generated files. AR 21/9/2003 diff --git a/src/GF/Data/Glue.hs b/src/GF/Data/Glue.hs index cfbe0e746..c541446b1 100644 --- a/src/GF/Data/Glue.hs +++ b/src/GF/Data/Glue.hs @@ -9,17 +9,15 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@ ----------------------------------------------------------------------------- -module Glue where +module Glue (decomposeSimple, exTrie) where import Trie2 import Operations import List --------- AR 8/11/2003, using Markus Forsberg's implementation of Huet's unglue - decomposeSimple :: Trie Char a -> [Char] -> Err [[Char]] decomposeSimple t s = do let ss = map (decompose t) $ words s diff --git a/src/GF/Data/Map.hs b/src/GF/Data/Map.hs index 60ba69052..107a2f6c9 100644 --- a/src/GF/Data/Map.hs +++ b/src/GF/Data/Map.hs @@ -1,9 +1,9 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : Map +-- Maintainer : Markus Forsberg +-- Stability : Stable +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ @@ -12,16 +12,6 @@ -- (Description of the module) ----------------------------------------------------------------------------- -{- - ************************************************************** - * Filename : Map.hs * - * Author : Markus Forsberg * - * markus@cs.chalmers.se * - * Last Modified : 15 December, 2001 * - * Lines : 53 * - ************************************************************** --} - module Map ( Map, diff --git a/src/GF/Data/OrdMap2.hs b/src/GF/Data/OrdMap2.hs index 213f40b52..2d0f58f51 100644 --- a/src/GF/Data/OrdMap2.hs +++ b/src/GF/Data/OrdMap2.hs @@ -1,30 +1,22 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : OrdMap2 +-- Maintainer : Peter Ljunglöf +-- Stability : Obsolete +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- The class of finite maps, as described in +-- "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 ----------------------------------------------------------------------------- -{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Filename: OrdMap2.hs - Author: Peter Ljunglöf - Time-stamp: <2004-05-07 14:16:03 peb> - - Description: The class of finite maps, as described in - "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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} - module OrdMap2 (OrdMap(..), Map) where import List (intersperse) diff --git a/src/GF/Data/OrdSet.hs b/src/GF/Data/OrdSet.hs index 79393a892..f2a1ec115 100644 --- a/src/GF/Data/OrdSet.hs +++ b/src/GF/Data/OrdSet.hs @@ -1,30 +1,22 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : OrdSet +-- Maintainer : Peter Ljunglöf +-- Stability : Obsolete +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- The class of ordered sets, as described in +-- "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 ----------------------------------------------------------------------------- -{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Filename: OrdSet.hs - Author: Peter Ljunglöf - Time-stamp: <2004-05-07 14:16:12 peb> - - Description: The class of ordered sets, as described in - "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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} - module OrdSet (OrdSet(..), Set) where import List (intersperse) diff --git a/src/GF/Data/Parsers.hs b/src/GF/Data/Parsers.hs index 234ddff90..357868217 100644 --- a/src/GF/Data/Parsers.hs +++ b/src/GF/Data/Parsers.hs @@ -1,15 +1,17 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : Parsers +-- Maintainer : Aarne Ranta +-- Stability : Almost Obsolete +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- some parser combinators a` la Wadler and Hutton +-- no longer used in many places in GF +-- (only used in EBNF.hs) ----------------------------------------------------------------------------- module Parsers where @@ -28,8 +30,6 @@ infixr 5 ..+ infixr 6 |> infixr 3 <<< --- some parser combinators a` la Wadler and Hutton --- no longer used in many places in GF type Parser a b = [a] -> [(b,[a])] diff --git a/src/GF/Data/RedBlack.hs b/src/GF/Data/RedBlack.hs index 21e2f5586..635cbe3ad 100644 --- a/src/GF/Data/RedBlack.hs +++ b/src/GF/Data/RedBlack.hs @@ -1,27 +1,17 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : RedBlack +-- Maintainer : Markus Forsberg +-- Stability : Stable +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Modified version of Osanaki's implementation. ----------------------------------------------------------------------------- -{- - ************************************************************** - * Filename : RedBlack.hs * - * Author : Markus Forsberg * - * markus@cs.chalmers.se * - * Last Modified : 15 December, 2001 * - * Lines : 57 * - ************************************************************** --} -- Modified version of Osanaki's implementation. - module RedBlack ( emptyTree, isEmpty, diff --git a/src/GF/Data/Trie.hs b/src/GF/Data/Trie.hs index 7cfe51fa2..e32b8560d 100644 --- a/src/GF/Data/Trie.hs +++ b/src/GF/Data/Trie.hs @@ -1,9 +1,9 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : Trie +-- Maintainer : Markus Forsberg +-- Stability : Obsolete??? +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ @@ -12,16 +12,6 @@ -- (Description of the module) ----------------------------------------------------------------------------- -{- - ************************************************************** - * Filename : Trie.hs * - * Author : Markus Forsberg * - * markus@cs.chalmers.se * - * Last Modified : 17 December, 2001 * - * Lines : 51 * - ************************************************************** --} - module Trie ( tcompile, collapse, diff --git a/src/GF/Data/Trie2.hs b/src/GF/Data/Trie2.hs index d4f6a59b4..5f2d3de0a 100644 --- a/src/GF/Data/Trie2.hs +++ b/src/GF/Data/Trie2.hs @@ -1,9 +1,9 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) +-- Module : Trie2 +-- Maintainer : Markus Forsberg +-- Stability : Stable +-- Portability : Haskell 98 -- -- > CVS $Date $ -- > CVS $Author $ @@ -12,12 +12,6 @@ -- (Description of the module) ----------------------------------------------------------------------------- -{- - ************************************************************** - * Author : Markus Forsberg * - * markus@cs.chalmers.se * - ************************************************************** --} module Trie2 ( tcompile, collapse, diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs index 31174b71e..6d3766c51 100644 --- a/src/GF/Data/Zipper.hs +++ b/src/GF/Data/Zipper.hs @@ -9,15 +9,13 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- Gérard Huet's zipper (JFP 7 (1997)). AR 10/8/2001 ----------------------------------------------------------------------------- module Zipper where import Operations --- Gérard Huet's zipper (JFP 7 (1997)). AR 10/8/2001 - newtype Tr a = Tr (a,[Tr a]) deriving (Show,Eq) data Path a = diff --git a/src/GF/Infra/CheckM.hs b/src/GF/Infra/CheckM.hs index 3794cc903..8f0657e27 100644 --- a/src/GF/Infra/CheckM.hs +++ b/src/GF/Infra/CheckM.hs @@ -19,7 +19,7 @@ import Grammar import Ident import PrGrammar --- the strings are non-fatal warnings +-- | the strings are non-fatal warnings type Check a = STM (Context,[String]) a checkError :: String -> Check a @@ -28,7 +28,7 @@ checkError = raise checkCond :: String -> Bool -> Check () checkCond s b = if b then return () else checkError s --- warnings should be reversed in the end +-- | warnings should be reversed in the end checkWarn :: String -> Check () checkWarn s = updateSTM (\ (cont,msg) -> (cont, s:msg)) diff --git a/src/GF/Infra/Comments.hs b/src/GF/Infra/Comments.hs index e5f74f5ab..919b7dd12 100644 --- a/src/GF/Infra/Comments.hs +++ b/src/GF/Infra/Comments.hs @@ -12,9 +12,10 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Comments where +module Comments ( remComments + ) where --- comment removal : line tails prefixed by -- as well as chunks in {- ... -} +-- | comment removal : line tails prefixed by -- as well as chunks in {- ... -} remComments :: String -> String remComments s = diff --git a/src/GF/Infra/Ident.hs b/src/GF/Infra/Ident.hs index fe2d7d82d..659084b1b 100644 --- a/src/GF/Infra/Ident.hs +++ b/src/GF/Infra/Ident.hs @@ -17,14 +17,17 @@ module Ident where import Operations -- import Monad + +-- | the constructors labelled /INTERNAL/ are +-- internal representation never returned by the parser data Ident = - IC String -- raw identifier after parsing, resolved in Rename - | IW -- wildcard + IC String -- ^ raw identifier after parsing, resolved in Rename + | IW -- ^ wildcard -- below this line: internal representation never returned by the parser - | IV (Int,String) -- variable - | IA (String,Int) -- argument of cat at position - | IAV (String,Int,Int) -- argument of cat with bindings at position + | IV (Int,String) -- ^ /INTERNAL/ variable + | IA (String,Int) -- ^ /INTERNAL/ argument of cat at position + | IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position deriving (Eq, Ord, Show, Read) @@ -42,14 +45,14 @@ prIdent i = case i of -- normal identifier -- ident s = IC s --- to mark argument variables +-- | to mark argument variables argIdent 0 (IC c) i = identA (c,i) argIdent b (IC c) i = identAV (c,b,i) --- used in lin defaults +-- | used in lin defaults strVar = identA ("str",0) --- wild card +-- | wild card wildIdent = identW isWildIdent :: Ident -> Bool diff --git a/src/GF/Text/Arabic.hs b/src/GF/Text/Arabic.hs index 5399613ed..2e245c217 100644 --- a/src/GF/Text/Arabic.hs +++ b/src/GF/Text/Arabic.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Arabic where +module Arabic (mkArabic) where mkArabic :: String -> String mkArabic = unwords . (map mkArabicWord) . words diff --git a/src/GF/Text/Devanagari.hs b/src/GF/Text/Devanagari.hs index 422cafec3..a66477449 100644 --- a/src/GF/Text/Devanagari.hs +++ b/src/GF/Text/Devanagari.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Devanagari where +module Devanagari (mkDevanagari) where mkDevanagari :: String -> String mkDevanagari = digraphWordToUnicode . adHocToDigraphWord diff --git a/src/GF/Text/Ethiopic.hs b/src/GF/Text/Ethiopic.hs index 567f98e41..520dbb540 100644 --- a/src/GF/Text/Ethiopic.hs +++ b/src/GF/Text/Ethiopic.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Ethiopic where +module Ethiopic (mkEthiopic) where -- Ascii-Unicode decoding for Ethiopian -- Copyright (c) Harald Hammarström 2003 under Gnu General Public License diff --git a/src/GF/Text/ExtendedArabic.hs b/src/GF/Text/ExtendedArabic.hs index 8d1f3657a..4625a5a97 100644 --- a/src/GF/Text/ExtendedArabic.hs +++ b/src/GF/Text/ExtendedArabic.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module ExtendedArabic where +module ExtendedArabic (mkArabic0600, mkExtendedArabic) where mkArabic0600 :: String -> String mkArabic0600 = digraphWordToUnicode . aarnesToDigraphWord diff --git a/src/GF/Text/ExtraDiacritics.hs b/src/GF/Text/ExtraDiacritics.hs index 61bbb52d7..03b9dd4ff 100644 --- a/src/GF/Text/ExtraDiacritics.hs +++ b/src/GF/Text/ExtraDiacritics.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module ExtraDiacritics where +module ExtraDiacritics (mkExtraDiacritics) where mkExtraDiacritics :: String -> String mkExtraDiacritics = mkExtraDiacriticsWord diff --git a/src/GF/Text/Greek.hs b/src/GF/Text/Greek.hs index e51ddafc4..68d0a6e2a 100644 --- a/src/GF/Text/Greek.hs +++ b/src/GF/Text/Greek.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Greek where +module Greek (mkGreek) where mkGreek :: String -> String mkGreek = unwords . (map mkGreekWord) . mkGravis . words diff --git a/src/GF/Text/Hebrew.hs b/src/GF/Text/Hebrew.hs index 423126f5b..c5e8c7b89 100644 --- a/src/GF/Text/Hebrew.hs +++ b/src/GF/Text/Hebrew.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Hebrew where +module Hebrew (mkHebrew) where mkHebrew :: String -> String mkHebrew = mkHebrewWord diff --git a/src/GF/Text/Hiragana.hs b/src/GF/Text/Hiragana.hs index ba1ca6322..69b534128 100644 --- a/src/GF/Text/Hiragana.hs +++ b/src/GF/Text/Hiragana.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Hiragana where +module Hiragana (mkJapanese) where -- long vowel romaaji must be ei, ou not ee, oo diff --git a/src/GF/Text/LatinASupplement.hs b/src/GF/Text/LatinASupplement.hs index 5a1794e20..0bb070a00 100644 --- a/src/GF/Text/LatinASupplement.hs +++ b/src/GF/Text/LatinASupplement.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module LatinASupplement where +module LatinASupplement (mkLatinASupplement) where mkLatinASupplement :: String -> String mkLatinASupplement = mkLatinASupplementWord diff --git a/src/GF/Text/OCSCyrillic.hs b/src/GF/Text/OCSCyrillic.hs index 71f908bd2..894a29e14 100644 --- a/src/GF/Text/OCSCyrillic.hs +++ b/src/GF/Text/OCSCyrillic.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module OCSCyrillic where +module OCSCyrillic (mkOCSCyrillic) where mkOCSCyrillic :: String -> String mkOCSCyrillic = mkOCSCyrillicWord diff --git a/src/GF/Text/Russian.hs b/src/GF/Text/Russian.hs index 1654652b8..14753f964 100644 --- a/src/GF/Text/Russian.hs +++ b/src/GF/Text/Russian.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Russian where +module Russian (mkRussian, mkRusKOI8) where -- an ad hoc ASCII encoding. Delimiters: /_ _/ mkRussian :: String -> String diff --git a/src/GF/Text/Tamil.hs b/src/GF/Text/Tamil.hs index 524a8a762..ec8d78ef1 100644 --- a/src/GF/Text/Tamil.hs +++ b/src/GF/Text/Tamil.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module Tamil where +module Tamil (mkTamil) where mkTamil :: String -> String mkTamil = digraphWordToUnicode . adHocToDigraphWord diff --git a/src/GF/Text/UTF8.hs b/src/GF/Text/UTF8.hs index 825bd2802..34116ffd9 100644 --- a/src/GF/Text/UTF8.hs +++ b/src/GF/Text/UTF8.hs @@ -12,7 +12,7 @@ -- (Description of the module) ----------------------------------------------------------------------------- -module UTF8 where +module UTF8 (decodeUTF8, encodeUTF8) where -- From the Char module supplied with HBC. -- code by Thomas Hallgren (Jul 10 1999) diff --git a/src/GF/Text/Unicode.hs b/src/GF/Text/Unicode.hs index f24019b47..9039fbef0 100644 --- a/src/GF/Text/Unicode.hs +++ b/src/GF/Text/Unicode.hs @@ -9,10 +9,11 @@ -- > CVS $Author $ -- > CVS $Revision $ -- --- (Description of the module) +-- ad hoc Unicode conversions from different alphabets +-- AR 12/4/2000, 18/9/2001, 30/5/2002, 26/1/2004 ----------------------------------------------------------------------------- -module Unicode where +module Unicode (mkUnicode, treat) where import Greek (mkGreek) import Arabic (mkArabic) @@ -30,10 +31,6 @@ import ExtraDiacritics (mkExtraDiacritics) import Char --- ad hoc Unicode conversions from different alphabets - --- AR 12/4/2000, 18/9/2001, 30/5/2002, 26/1/2004 - mkUnicode s = case s of '/':'/':cs -> treat [] mkGreek unic ++ mkUnicode rest '/':'+':cs -> mkHebrew unic ++ mkUnicode rest @@ -58,7 +55,7 @@ mkUnicode s = case s of c:cs -> remClosing (c:u) cs _ -> (reverse u,[]) -- forgiving missing end --- don't convert XML tags --- assumes <> always means XML tags +-- | don't convert XML tags --- assumes \<\> always means XML tags treat :: String -> (String -> String) -> String -> String treat old mk s = case s of '<':cs -> mk (reverse old) ++ '<':noTreat cs diff --git a/src/module-structure.txt b/src/module-structure.txt new file mode 100644 index 000000000..a5e6a3ff7 --- /dev/null +++ b/src/module-structure.txt @@ -0,0 +1,253 @@ + + +följande är en föreslagen hierarkisk modulstruktur för GF 2.2 + +katalogen src kommer att innehålla (åtminstone) följande: + - GF.hs modulen Main + - GF/ resten av Haskell-filerna + - JavaGUI/ java-filer + - haddock-script.csh för att skapa haddock-dokumentation + - haddock-resources/ nödvändiga filer för haddock-script.csh + - haddock/ html-resultat efter att ha kört haddock + +modifiera gärna strukturen och kommentarerna nedan +---------------------------------------------------------------------- + +GF + +GF/ + GFModes - flyttas till Shell?? + + API/ + API + BatchTranslate + GrammarToHaskell + IOGrammar + MyParser - obsolet? + + CF/ - bör så småningom försvinna + (ersättas med mer generell CFG-datatyp) + CF + CFIdent + CFtoGrammar + CFtoSRG + CanonToCF + ChartParser - obsolet. + EBNF - ta bort parserkombinatorerna -- skapa en bncf-fil + PPrCF + PrLBNF + Profile + + Canon/ + AbsGFC [1/2 - AUTO] + CMacros + CanonToGrammar + GFC + GetGFC + Look + MkGFC + PrExp + Share + Unlex + LexGFC [AUTO] + ParGFC [AUTO] + PrintGFC [1/2 - AUTO] + SkelGFC [AUTO] + TestGFC [AUTO] + + [GFC.cf] bnfc-fil + [ParGFC.y] [AUTO] happy-fil + [LexGFC.x] [AUTO] alex-fil + + Compile/ + CheckGrammar + Compile + Extend + GetGrammar + GrammarToCanon + MkResource + MkUnion + ModDeps + NewRename + Optimize + PGrammar + PrOld + Rebuild + RemoveLiT + Rename + ShellState + Update + + Data/ + Assoc + Glue + Map - slås ihop med RedBlackSet + OrdMap2 - obsolet - använd Assoc istället + OrdSet - obsolet - använd SortedList istället + RedBlack \ slås samman + RedBlackSet / + SharedString [AUTO?] + SortedList + Trie \ slås samman + Trie2 / + Zipper + CheckM + ErrM + + Fudgets/ + EventF + FudgetOps + UnicodeF + WriteF + CommandF + + Grammar/ + AbsCompute + Abstract + AppPredefined + Compute + Grammar + LookAbs + Lookup + MMacros + Macros + PatternMatch + PrGrammar + Refresh + ReservedWords + TC + TypeCheck + Unify + Values + + CFGM/ + AbsCFG [AUTO] + LexCFG [AUTO] + ParCFG [AUTO] + PrintCFG [AUTO] + PrintCFGrammar + + [CFG.cf] bnfc-fil + [ParCFG.y] [AUTO] happy-fil + [LexCFG.x] [AUTO] alex-fil + + Source/ + AbsGF [AUTO] + LexGF [AUTO] + ParGF [AUTO] + PrintGF [AUTO] + SkelGF [AUTO] + TestGF [AUTO] + SourceToGrammar + GrammarToSource + + [GF.cf] bnfc-fil + [ParGF.y] [AUTO] happy-fil + [LexGF.x] [AUTO] alex-fil + + Infra/ + Comments + Ident + Modules + Operations + Option + Parsers - nästan obsolet (används bara i EBNF) + ReadFiles + Str + UseIO + + Parsing/ dela upp i Grammar och Parsing? + (då måste nuvarande Grammar byta namn) + CFGrammar -> Grammar + CFParserGeneral + CFParserIncremental + ConvertGFCtoMCFG -> Grammar + ConvertGrammar -> Grammar + ConvertMCFGtoCFG -> Grammar + GeneralChart + GrammarTypes -> Grammar + IncrementalChart + MCFGrammar -> Grammar + MCFParserBasic + MCFRange + ParseCF + ParseCFG + ParseGFC + ParseMCFG + Parser + PrintParser + PrintSimplifiedTerm + + Shell/ + CommandL + Commands + JGF + PShell + Shell + ShellCommands + SubShell + TeachYourself + + Speech/ + PrGSL + PrJSGF + SRG + TransformCFG + + System/ + Arch + ArchEdit + Tracing + + Text/ + Arabic + Devanagari + Ethiopic + ExtendedArabic + ExtraDiacritics + Greek + Hebrew + Hiragana + LatinASupplement + OCSCyrillic + Russian + Tamil + Text + UTF8 + Unicode + + Translate/ + GFT + + UseGrammar/ + Custom + Editing + Generate + GetTree + Information + Linear + MoreCustom - obsolet? + Morphology + Paraphrases + Parsing + Randomized + RealMoreCustom - obsolet? + Session + TeachYourself + Tokenize + Transfer + + Util/ byta namn till Extra? + Today [AUTO] + HelpFile [AUTO] + AlphaConvGF + GFDoc + Htmls + MkHelpFile + HelpFile byta namn till HelpFile.txt? + + [mkHelpFile.perl] ersättning för MkHelpFile? + [mktoday.sh] + + Visualization/ + VisualizeGrammar diff --git a/src/tools/mktoday.sh b/src/tools/mktoday.sh index 2e13c5020..c563e363b 100644 --- a/src/tools/mktoday.sh +++ b/src/tools/mktoday.sh @@ -1,2 +1,6 @@ #!/bin/sh -echo 'module Today where today = "'`date`'"' > Today.hs + +echo 'module Today (today) where' > Today.hs +echo 'today :: String' >> Today.hs +echo 'today = "'`date`'"' >> Today.hs +