"Committed_by_peb"

This commit is contained in:
peb
2005-02-18 18:21:06 +00:00
parent 1c4f025320
commit 9568d7a844
149 changed files with 1518 additions and 1160 deletions

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.27 $
-- --
-- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001 -- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- translate OCL, etc, files in batch mode -- translate OCL, etc, files in batch mode
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- to write a GF abstract grammar into a Haskell module with translations from -- to write a GF abstract grammar into a Haskell module with translations from
-- data objects into GF trees. Example: GSyntax for Agda. -- data objects into GF trees. Example: GSyntax for Agda.

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.14 $
-- --
-- for reading grammars and terms from strings and files -- for reading grammars and terms from strings and files
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- template to define your own parser (obsolete?) -- template to define your own parser (obsolete?)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,38 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- context-free grammars. AR 15/12/1999 -- 30/3/2000 -- 2/6/2001 -- 3/12/2001 -- context-free grammars. AR 15\/12\/1999 -- 30\/3\/2000 -- 2\/6\/2001 -- 3\/12\/2001
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CF where module CF (-- * Types
CF(..), CFRule, CFRuleGroup,
CFItem(..), CFTree(..), CFPredef, CFParser,
RegExp(..), CFWord,
-- * Functions
cfParseResults,
-- ** to construct CF grammars
emptyCF, emptyCFPredef, rules2CF, groupCFRules,
-- ** to construct rules
atomCFRule, atomCFTerm, atomRegExp, altsCFTerm,
-- ** to construct trees
atomCFTree, buildCFTree,
-- ** to decide whether a token matches a terminal item
matchCFTerm, satRegExp,
-- ** to analyse a CF grammar
catsOfCF, rulesOfCF, ruleGroupsOfCF, rulesForCFCat,
valCatCF, valItemsCF, valFunCF,
startCat, predefOfCF, appCFPredef, valCFItem,
cfTokens, wordsOfRegExp, forCFItem,
isCircularCF, predefRules
) where
import Operations import Operations
import Str import Str
@@ -182,10 +202,10 @@ forCFItem :: CFTok -> CFRule -> Bool
forCFItem a (_,(_, CFTerm r : _)) = satRegExp r a forCFItem a (_,(_, CFTerm r : _)) = satRegExp r a
forCFItem _ _ = False forCFItem _ _ = False
-- | we should make a test of circular chains, too
isCircularCF :: CFRule -> Bool isCircularCF :: CFRule -> Bool
isCircularCF (_,(c', CFNonterm c:[])) = compatCF c' c isCircularCF (_,(c', CFNonterm c:[])) = compatCF c' c
isCircularCF _ = False 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 :: CFPredef -> CFTok -> [CFRule]

View File

@@ -1,18 +1,35 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CFIdent
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.10 $
-- --
-- symbols (categories, functions) for context-free grammars. -- symbols (categories, functions) for context-free grammars.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CFIdent where module CFIdent (-- * Tokens and categories
CFTok(..), CFCat(..),
tS, tC, tL, tI, tV, tM, tInt,
prCFTok,
-- * Function names and profiles
CFFun(..), Profile,
wordsCFTok,
-- * CF Functions
mkCFFun, varCFFun, consCFFun, string2CFFun, stringCFFun, intCFFun, dummyCFFun,
cfFun2String, cfFun2Ident, cfFun2Profile, metaCFFun,
-- * CF Categories
mkCIdent, ident2CFCat, string2CFCat, catVarCF, cat2CFCat, cfCatString, cfCatInt,
moduleOfCFCat, cfCat2Cat, cfCat2Ident, lexCFCat,
-- * CF Tokens
string2CFTok, str2cftoks,
-- * Comparisons
compatToks, compatTok, compatCFFun, compatCF
) where
import Operations import Operations
import GFC import GFC
@@ -37,7 +54,13 @@ data CFTok =
-- | this type should be abstract -- | this type should be abstract
newtype CFCat = CFCat (CIdent,Label) deriving (Eq, Ord, Show) newtype CFCat = CFCat (CIdent,Label) deriving (Eq, Ord, Show)
tS, tC, tL, tI, tV, tM :: String -> CFTok tS :: String -> CFTok
tC :: String -> CFTok
tL :: String -> CFTok
tI :: String -> CFTok
tV :: String -> CFTok
tM :: String -> CFTok
tS = TS tS = TS
tC = TC tC = TC
tL = TL tL = TL
@@ -91,8 +114,9 @@ stringCFFun = mkCFFun . AS
intCFFun :: Int -> CFFun intCFFun :: Int -> CFFun
intCFFun = mkCFFun . AI . toInteger intCFFun = mkCFFun . AI . toInteger
-- | used in lexer-by-need rules
dummyCFFun :: CFFun dummyCFFun :: CFFun
dummyCFFun = varCFFun $ identC "_" --- used in lexer-by-need rules dummyCFFun = varCFFun $ identC "_"
cfFun2String :: CFFun -> String cfFun2String :: CFFun -> String
cfFun2String (CFFun (f,_)) = prt f cfFun2String (CFFun (f,_)) = prt f
@@ -134,7 +158,10 @@ cat2CFCat :: (Ident,Ident) -> CFCat
cat2CFCat = uncurry idents2CFCat cat2CFCat = uncurry idents2CFCat
-- | literals -- | literals
cfCatString :: CFCat
cfCatString = string2CFCat (prt cPredefAbs) "String" cfCatString = string2CFCat (prt cPredefAbs) "String"
cfCatInt :: CFCat
cfCatInt = string2CFCat (prt cPredefAbs) "Int" cfCatInt = string2CFCat (prt cPredefAbs) "Int"
@@ -170,6 +197,7 @@ str2cftoks = map tS . words . sstr
compatToks :: [CFTok] -> [CFTok] -> Bool compatToks :: [CFTok] -> [CFTok] -> Bool
compatToks ts us = and [compatTok t u | (t,u) <- zip ts us] compatToks ts us = and [compatTok t u | (t,u) <- zip ts us]
compatTok :: CFTok -> CFTok -> Bool
compatTok (TM _ _) _ = True --- hack because metas are renamed compatTok (TM _ _) _ = True --- hack because metas are renamed
compatTok _ (TM _ _) = True compatTok _ (TM _ _) = True
compatTok t u = any (`elem` (alts t)) (alts u) where compatTok t u = any (`elem` (alts t)) (alts u) where

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CFtoGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- 26\/1\/2000 -- 18\/4 -- 24\/3\/2004 -- 26\/1\/2000 -- 18\/4 -- 24\/3\/2004
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- This module prints a CF as a SRG (Speech Recognition Grammar). -- This module prints a CF as a SRG (Speech Recognition Grammar).
-- Created : 21 January, 2001. -- Created : 21 January, 2001.

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CanonToCF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003 -- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- Bottom-up Kilbury chart parser from "Pure Functional Parsing", chapter 5. -- Bottom-up Kilbury chart parser from "Pure Functional Parsing", chapter 5.
-- OBSOLETE -- should use new MCFG parsers instead -- OBSOLETE -- should use new MCFG parsers instead

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : EBNF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PPrCF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.9 $
-- --
-- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003 -- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003
-- --

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PrLBNF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.8 $
-- --
-- Printing CF grammars generated from GF as LBNF grammar for BNFC. -- 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. -- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004.

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Profile
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.7 $
-- --
-- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001 -- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001
-- revised 8/4/2002 for the new profile structure -- revised 8/4/2002 for the new profile structure

View File

@@ -1,16 +1,3 @@
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module AbsCFG where module AbsCFG where

View File

@@ -1,16 +1,3 @@
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module PrintCFG where module PrintCFG where

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PrintCFGrammar
-- Maintainer : (Maintainer) -- Maintainer : (Maintainer)
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- Handles printing a CFGrammar in CFGM format. -- Handles printing a CFGrammar in CFGM format.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,16 +1,3 @@
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module AbsGFC where module AbsGFC where

View File

@@ -1,15 +1,17 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CMacros
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.20 $
-- --
-- Macros for building and analysing terms in GFC concrete syntax. -- Macros for building and analysing terms in GFC concrete syntax.
--
-- macros for concrete syntax in GFC that do not need lookup in a grammar
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CMacros where module CMacros where
@@ -27,8 +29,6 @@ import Operations
import Char import Char
import Monad 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) type JustMarker = V.TrNode -> [Int] -> Bool -> (String, String)

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CanonToGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.12 $
-- --
-- a decompiler. AR 12/6/2003 -- 19/4/2004 -- a decompiler. AR 12/6/2003 -- 19/4/2004
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,27 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : GFC
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9 -- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GFC where module GFC (Context,
CanonGrammar,
CanonModInfo,
CanonModule,
CanonAbs,
Info(..),
Printname,
mapInfoTerms,
setFlag
) where
import AbsGFC import AbsGFC
import PrintGFC import PrintGFC

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : GetGFC
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,28 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Look
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- lookup in GFC. AR 2003 -- lookup in GFC. AR 2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Look where module Look (lookupCncInfo,
lookupLin,
lookupLincat,
lookupPrintname,
lookupResInfo,
lookupGlobal,
lookupOptionsCan,
lookupParamValues,
allParamValues,
ccompute
) where
import AbsGFC import AbsGFC
import GFC import GFC

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : MkGFC
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PrExp
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- print trees without qualifications -- print trees without qualifications
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,16 +1,3 @@
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module PrintGFC where module PrintGFC where

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.10 $
-- --
-- Optimizations on GFC code: sharing, parametrization, value sets. -- Optimizations on GFC code: sharing, parametrization, value sets.
-- --

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/17 10:22:10 $ -- > CVS $Date: 2005/02/18 19:21:07 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.7 $
-- --
-- elementary text postprocessing. AR 21/11/2001 -- elementary text postprocessing. AR 21/11/2001
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : BackOpt
-- Maintainer : Aarne Ranta -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- Optimizations on GF source code: sharing, parametrization, value sets. -- Optimizations on GF source code: sharing, parametrization, value sets.
-- --

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CheckGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.20 $
-- --
-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003 -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
-- --
@@ -20,7 +20,7 @@
-- - tables are type-annotated -- - tables are type-annotated
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CheckGrammar where module CheckGrammar (showCheckModule, justCheckLTerm) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,18 +1,19 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Compile
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.33 $
-- --
-- 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 module Compile (compileModule, compileEnvShSt, compileOne
) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Extend
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.15 $
-- --
-- AR 14\/5\/2003 -- 11\/11 -- AR 14\/5\/2003 -- 11\/11
-- --
@@ -15,7 +15,8 @@
-- extends a module symbol table by indirections to the module it extends -- extends a module symbol table by indirections to the module it extends
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Extend where module Extend (extendModule, extendMod
) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,18 +1,20 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : GetGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.14 $
-- --
-- this module builds the internal GF grammar that is sent to the type checker -- this module builds the internal GF grammar that is sent to the type checker
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GetGrammar where module GetGrammar (getSourceModule, getOldGrammar, getCFGrammar, getEBNFGrammar,
err2err
) where
import Operations import Operations
import qualified ErrM as E ---- import qualified ErrM as E ----

View File

@@ -1,18 +1,20 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : GrammarToCanon
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.16 $
-- --
-- Code generator from optimized GF source code to GFC. -- Code generator from optimized GF source code to GFC.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GrammarToCanon where module GrammarToCanon (showGFC,
redModInfo, redQIdent
) where
import Operations import Operations
import Zipper import Zipper

View File

@@ -1,18 +1,18 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : MkResource
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- Compile a gfc module into a "reuse" gfr resource, interface, or instance. -- Compile a gfc module into a "reuse" gfr resource, interface, or instance.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module MkResource where module MkResource (makeReuse) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : MkUnion
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- building union of modules. -- building union of modules.
-- AR 1\/3\/2004 --- OBSOLETE 15\/9\/2004 with multiple inheritance -- AR 1\/3\/2004 --- OBSOLETE 15\/9\/2004 with multiple inheritance

View File

@@ -1,20 +1,24 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : ModDeps
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- Check correctness of module dependencies. Incomplete. -- Check correctness of module dependencies. Incomplete.
-- --
-- AR 13/5/2003 -- AR 13\/5\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ModDeps where module ModDeps (mkSourceGrammar,
moduleDeps,
openInterfaces,
requiredCanModules
) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,15 +1,15 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : NewRename
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- AR 14/5/2003 -- AR 14\/5\/2003
-- --
-- The top-level function 'renameGrammar' does several things: -- The top-level function 'renameGrammar' does several things:
-- --
@@ -23,7 +23,7 @@
-- Hence we can proceed by @fold@ing "from left to right". -- Hence we can proceed by @fold@ing "from left to right".
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Rename where module Rename (renameSourceTerm, renameModule) where
import Grammar import Grammar
import Values import Values

View File

@@ -1,18 +1,18 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Optimize
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.13 $
-- --
-- Top-level partial evaluation for GF source modules. -- Top-level partial evaluation for GF source modules.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Optimize where module Optimize (optimizeModule) where
import Grammar import Grammar
import Ident import Ident

View File

@@ -1,18 +1,21 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module PGrammar where module PGrammar (pTerm, pTrm, pTrms,
pMeta, pzIdent,
string2ident
) where
---import LexGF ---import LexGF
import ParGF import ParGF

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PrOld
-- Maintainer : (Maintainer) -- Maintainer : GF
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.7 $
-- --
-- a hack to print gf2 into gf1 readable files -- a hack to print gf2 into gf1 readable files
-- Works only for canonical grammars, printed into GFC. Otherwise we would have -- Works only for canonical grammars, printed into GFC. Otherwise we would have
@@ -15,7 +15,7 @@
-- --- printnames are not preserved, nor are lindefs -- --- printnames are not preserved, nor are lindefs
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module PrOld where module PrOld (printGrammarOld, stripTerm) where
import PrGrammar import PrGrammar
import CanonToGrammar import CanonToGrammar
@@ -59,6 +59,7 @@ stripInfo (c,i) = case i of
stripContext co = [(x, stripTerm t) | (x,t) <- co] stripContext co = [(x, stripTerm t) | (x,t) <- co]
stripTerm :: Term -> Term
stripTerm t = case t of stripTerm t = case t of
Q _ c -> Vr c Q _ c -> Vr c
QC _ c -> Vr c QC _ c -> Vr c

View File

@@ -1,18 +1,18 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Rebuild
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.9 $
-- --
-- Rebuild a source module from incomplete and its with-instance. -- Rebuild a source module from incomplete and its with-instance.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Rebuild where module Rebuild (rebuildModule) where
import Grammar import Grammar
import ModDeps import ModDeps

View File

@@ -1,19 +1,19 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : RemoveLiT
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003 -- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003
-- --
-- What the program does is replace the occurrences of Lin C with the actual -- What the program does is replace the occurrences of Lin C with the actual
-- definition T given in lincat C = T ; with {s : Str} if no lincat is found. -- definition T given in lincat C = T ; with {s : Str} if no lincat is found.
-- The procedule is uncertain, if T contains another Lin. -- The procedure is uncertain, if T contains another Lin.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module RemoveLiT (removeLiT) where module RemoveLiT (removeLiT) where

View File

@@ -1,15 +1,15 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Rename
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.17 $
-- --
-- AR 14/5/2003 -- AR 14\/5\/2003
-- The top-level function 'renameGrammar' does several things: -- The top-level function 'renameGrammar' does several things:
-- --
-- - extends each module symbol table by indirections to extended module -- - extends each module symbol table by indirections to extended module
@@ -22,7 +22,10 @@
-- Hence we can proceed by @fold@ing "from left to right". -- Hence we can proceed by @fold@ing "from left to right".
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Rename where module Rename (renameGrammar,
renameSourceTerm,
renameModule
) where
import Grammar import Grammar
import Values import Values

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : ShellState
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.35 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,23 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Update
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Update where module Update (updateRes, buildAnyTree, combineAnyInfos, unifyAnyInfo,
-- * these auxiliaries should be somewhere else
-- since they don't use the info types
groupInfos, sortInfos, combineInfos, unifyInfos,
tryInsert, unifAbsDefs, unifConstrs
) where
import Ident import Ident
import Grammar import Grammar

View File

@@ -1,20 +1,19 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : ErrM
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:14 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- hack for BNFC generated files. AR 21/9/2003 -- hack for BNFC generated files. AR 21/9/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ErrM ( module ErrM (module Operations
module Operations ) where
) where
import Operations import Operations

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Glue
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:14 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@ -- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,24 +5,23 @@
-- Stability : Stable -- Stability : Stable
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Map module Map (
(
Map, Map,
empty, empty,
isEmpty, isEmpty,
(!), -- lookup operator. (!),
(!+), -- lookupMany operator. (!+),
(|->), -- insert operator. (|->),
(|->+), -- insertMany operator. (|->+),
(<+>), -- union operator. (<+>),
flatten -- flatten
) where ) where
import RedBlack import RedBlack
@@ -38,20 +37,25 @@ infixl 4 <+>
empty :: Map key el empty :: Map key el
empty = emptyTree empty = emptyTree
-- | lookup operator.
(!) :: Ord key => Map key el -> key -> Maybe el (!) :: Ord key => Map key el -> key -> Maybe el
fm ! e = lookupTree e fm fm ! e = lookupTree e fm
-- | lookupMany operator.
(!+) :: Ord key => Map key el -> [key] -> [Maybe el] (!+) :: Ord key => Map key el -> [key] -> [Maybe el]
fm !+ [] = [] fm !+ [] = []
fm !+ (e:es) = (lookupTree e fm): (fm !+ es) fm !+ (e:es) = (lookupTree e fm): (fm !+ es)
-- | insert operator.
(|->) :: Ord key => (key,el) -> Map key el -> Map key el (|->) :: Ord key => (key,el) -> Map key el -> Map key el
(x,y) |-> fm = insertTree (x,y) fm (x,y) |-> fm = insertTree (x,y) fm
-- | insertMany operator.
(|->+) :: Ord key => [(key,el)] -> Map key el -> Map key el (|->+) :: Ord key => [(key,el)] -> Map key el -> Map key el
[] |->+ fm = fm [] |->+ fm = fm
((x,y):xs) |->+ fm = xs |->+ (insertTree (x,y) fm) ((x,y):xs) |->+ fm = xs |->+ (insertTree (x,y) fm)
-- | union operator.
(<+>) :: Ord key => Map key el -> Map key el -> Map key el (<+>) :: Ord key => Map key el -> Map key el -> Map key el
(<+>) fm1 fm2 = xs |->+ fm2 (<+>) fm1 fm2 = xs |->+ fm2
where xs = flatten fm1 where xs = flatten fm1

View File

@@ -1,18 +1,79 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Operations
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > 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 Char (isSpace, toUpper, isSpace, isDigit)
import List (nub, sortBy, sort, deleteBy, nubBy) import List (nub, sortBy, sort, deleteBy, nubBy)
@@ -24,9 +85,6 @@ infixr 5 ++++
infixr 5 +++++ infixr 5 +++++
infixl 9 !? 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 -> ([a] -> b) -> [a] -> b
ifNull b f xs = if null xs then b else f xs 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 -- 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) deriving (Read, Show, Eq)
instance Monad Err where instance Monad Err where
@@ -43,17 +102,18 @@ instance Monad Err where
Ok a >>= f = f a Ok a >>= f = f a
Bad s >>= f = Bad s 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 (Ok a) = Ok (f a)
fmap f (Bad s) = Bad s fmap f (Bad s) = Bad s
-- analogue of maybe -- | analogue of @maybe@
err :: (String -> b) -> (a -> b) -> Err a -> b err :: (String -> b) -> (a -> b) -> Err a -> b
err d f e = case e of err d f e = case e of
Ok a -> f a Ok a -> f a
Bad s -> d s Bad s -> d s
-- add msg s to Maybe failures -- | add msg s to @Maybe@ failures
maybeErr :: String -> Maybe a -> Err a maybeErr :: String -> Maybe a -> Err a
maybeErr s = maybe (Bad s) Ok maybeErr s = maybe (Bad s) Ok
@@ -66,7 +126,7 @@ errVal a = err (const a) id
errIn :: String -> Err a -> Err a errIn :: String -> Err a -> Err a
errIn msg = err (\s -> Bad (s ++++ "OCCURRED IN" ++++ msg)) return 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 :: String -> Err a -> Err a
derrIn m = errIn m -- id derrIn m = errIn m -- id
@@ -121,14 +181,14 @@ mapPairsM f xys =
pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c) pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
pairM op (t1,t2) = liftM2 (,) (op t1) (op t2) 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 :: (a -> Err b) -> [a] -> Err ([b], String)
mapErr f xs = Ok (ys, unlines ss) mapErr f xs = Ok (ys, unlines ss)
where where
(ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs]) (ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs])
fxs = map f xs 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 :: Int -> (a -> Err b) -> [a] -> Err ([b], String)
mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2)) mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2))
where where
@@ -139,8 +199,7 @@ mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2))
nss = length ss nss = length ss
fxs = map f xs 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 :: (a -> b -> Err a) -> a -> [b] -> Err (a, Maybe String)
foldErr f s xs = case xs of foldErr f s xs = case xs of
[] -> return (s,Nothing) [] -> return (s,Nothing)
@@ -148,7 +207,7 @@ foldErr f s xs = case xs of
Ok v -> foldErr f v xx Ok v -> foldErr f v xx
Bad m -> return $ (s, Just m) Bad m -> return $ (s, Just m)
-- !! with the error monad -- @!!@ with the error monad
(!?) :: [a] -> Int -> Err a (!?) :: [a] -> Int -> Err a
xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs 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 (Bad m) = Bad m
errAndMsg (Ok a) = return (a,[]) 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) data Perhaps a b = Yes a | May b | Nope deriving (Show,Read,Eq,Ord)
yes = Yes yes = Yes
@@ -191,7 +249,7 @@ mapP f p = case p of
May b -> May b May b -> May b
Nope -> Nope 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) => unifPerhaps :: (Eq a, Eq b, Show a, Show b) =>
Perhaps a b -> Perhaps a b -> Err (Perhaps a b) Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
unifPerhaps p1 p2 = case (p1,p2) of unifPerhaps p1 p2 = case (p1,p2) of
@@ -200,7 +258,7 @@ unifPerhaps p1 p2 = case (p1,p2) of
_ -> if p1==p2 then return p1 _ -> if p1==p2 then return p1
else Bad ("update conflict between" ++++ show p1 ++++ show p2) 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) => updatePerhaps :: (Eq a,Eq b, Show a, Show b) =>
b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b) b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
updatePerhaps old p1 p2 = case (p1,p2) of 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" (_, May a) -> Bad "strange indirection"
_ -> unifPerhaps p1 p2 _ -> 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 -> updatePerhapsHard :: (Eq a, Eq b, Show a, Show b) => b ->
Perhaps a b -> Perhaps a b -> Err (Perhaps a b) Perhaps a b -> Perhaps a b -> Err (Perhaps a b)
updatePerhapsHard old p1 p2 = case (p1,p2) of 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 -> isInBinTree x right
| x == a -> True | 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 -- 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 :: (Ord a) => BinTree (a,b) -> BinTree (a,b) -> [(a,(b,b))]
commonsInTree old new = foldr inOld [] new' where commonsInTree old new = foldr inOld [] new' where
new' = tree2list new new' = tree2list new
@@ -266,13 +324,11 @@ lookupTreeMany pr (t:ts) x = case lookupTree pr x t of
_ -> lookupTreeMany pr ts x _ -> lookupTreeMany pr ts x
lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr 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 :: (Ord a) => (a,b) -> BinTree (a,b) -> BinTree (a,b)
updateTree = updateTreeGen True updateTree = updateTreeGen True
-- destructive or not -- | destructive or not
updateTreeGen :: (Ord a) => Bool -> (a,b) -> BinTree (a,b) -> BinTree (a,b) updateTreeGen :: (Ord a) => Bool -> (a,b) -> BinTree (a,b) -> BinTree (a,b)
updateTreeGen destr z@(x,y) tree = case tree of updateTreeGen destr z@(x,y) tree = case tree of
NT -> BT z NT NT NT -> BT z NT NT
@@ -419,8 +475,7 @@ prIfEmpty :: String -> String -> String -> String -> String
prIfEmpty em _ _ [] = em prIfEmpty em _ _ [] = em
prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2 prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2
-- Thomas Hallgren's wrap lines -- | Thomas Hallgren's wrap lines
--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
wrapLines n "" = "" wrapLines n "" = ""
wrapLines n s@(c:cs) = wrapLines n s@(c:cs) =
if isSpace c if isSpace c
@@ -433,6 +488,8 @@ wrapLines n s@(c:cs) =
l = length w l = length w
_ -> s -- give up!! _ -> s -- give up!!
--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
-- LaTeX code producing functions -- LaTeX code producing functions
dollar s = '$' : s ++ "$" dollar s = '$' : s ++ "$"
@@ -468,8 +525,8 @@ sortByLongest = sortBy longer where
x' = length x x' = length x
y' = length y y' = length y
-- "combinations" is the same as "sequence"!!! -- | 'combinations' is the same as @sequence@!!!
-- peb 30/5-04 -- peb 30\/5-04
combinations :: [[a]] -> [[a]] combinations :: [[a]] -> [[a]]
combinations t = case t of 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] inDeg f = length [t | (h,hs) <- g, t <- hs, t == f]
lx = length g lx = length g
-- the generic fix point iterator -- | the generic fix point iterator
iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a] iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
iterFix more start = iter start start iterFix more start = iter start start
where where
@@ -549,8 +605,7 @@ updateAssoc ab@(a,b) as = case as of
removeAssoc :: Eq a => a -> [(a,b)] -> [(a,b)] removeAssoc :: Eq a => a -> [(a,b)] -> [(a,b)]
removeAssoc a = filter ((/=a) . fst) removeAssoc a = filter ((/=a) . fst)
-- chop into separator-separated parts -- | chop into separator-separated parts
chunks :: String -> [String] -> [[String]] chunks :: String -> [String] -> [[String]]
chunks sep ws = case span (/= sep) ws of chunks sep ws = case span (/= sep) ws of
(a,_:b) -> a : bs where bs = chunks sep b (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 (STM f) g = STM (\s -> (f s)
`handle` (\e -> let STM g' = (g e) in `handle` (\e -> let STM g' = (g e) in
g' s)) 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 :: ErrorMonad m => m a -> m a -> m a
checkAgain c1 c2 = handle_ c1 c2 checkAgain c1 c2 = handle_ c1 c2

View File

@@ -5,16 +5,16 @@
-- Stability : Obsolete -- Stability : Obsolete
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- The class of finite maps, as described in -- 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, -- and an example implementation,
-- derived from appendix A.2 -- 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 module OrdMap2 (OrdMap(..), Map) where

View File

@@ -5,16 +5,16 @@
-- Stability : Obsolete -- Stability : Obsolete
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- The class of ordered sets, as described in -- 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 -- and an example implementation
-- derived from appendix A.1 -- 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 module OrdSet (OrdSet(..), Set) where

View File

@@ -5,16 +5,31 @@
-- Stability : Almost Obsolete -- Stability : Almost Obsolete
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > 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 -- 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 Operations
import Char import Char

View File

@@ -5,9 +5,9 @@
-- Stability : Stable -- Stability : Stable
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- Modified version of Osanaki's implementation. -- Modified version of Osanaki's implementation.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -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 module SharedString (shareString) where

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Str
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -23,23 +23,23 @@ module Str (
import Operations import Operations
import List (isPrefixOf, isSuffixOf, intersperse) 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) newtype Str = Str [Tok] deriving (Read, Show, Eq, Ord)
data Tok = data Tok =
TK String 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 --- | TP Ss [(Ss, [String])] -- variants depending on previous string
deriving (Eq, Ord, Show, Read) deriving (Eq, Ord, Show, Read)
-- ^ notice that having both pre and post would leave to inconsistent situations:
-- notice that having both pre and post would leave to inconsistent situations: --
-- pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"} -- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}
--
-- always violates a condition expressed by the one or the other -- 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] type Ss = [String]
-- matching functions in both ways -- matching functions in both ways
@@ -80,8 +80,7 @@ str2allStrings (Str st) = alls st where
sstr :: Str -> String sstr :: Str -> String
sstr = unwords . str2strings sstr = unwords . str2strings
-- to handle a list of variants -- | to handle a list of variants
sstrV :: [Str] -> String sstrV :: [Str] -> String
sstrV ss = case ss of sstrV ss = case ss of
[] -> "*" [] -> "*"
@@ -127,8 +126,7 @@ glues ss tt = case (ss,tt) of
(_,[]) -> ss (_,[]) -> ss
_ -> init ss ++ [last ss ++ head tt] ++ tail tt _ -> 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 -> [String]
allItems (Str s) = concatMap allOne s where allItems (Str s) = concatMap allOne s where
allOne t = case t of allOne t = case t of

View File

@@ -2,12 +2,12 @@
-- | -- |
-- Module : Trie -- Module : Trie
-- Maintainer : Markus Forsberg -- Maintainer : Markus Forsberg
-- Stability : Obsolete??? -- Stability : Obsolete
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : Stable -- Stability : Stable
-- Portability : Haskell 98 -- Portability : Haskell 98
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,57 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Zipper
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > 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 import Operations
@@ -56,7 +95,7 @@ forgetNode _ = Bad $ "not a one-branch tree"
-- added sequential representation -- added sequential representation
-- a successor function -- | a successor function
goAhead :: Loc a -> Err (Loc a) goAhead :: Loc a -> Err (Loc a)
goAhead s@(Loc (t,p)) = case (t,p) of goAhead s@(Loc (t,p)) = case (t,p) of
(Tr (_,_:_),Node (_,_,_:_)) -> goDown s (Tr (_,_:_),Node (_,_,_:_)) -> goDown s
@@ -67,7 +106,7 @@ goAhead s@(Loc (t,p)) = case (t,p) of
Ok t' -> return t' Ok t' -> return t'
Bad _ -> goUp t >>= upsRight Bad _ -> goUp t >>= upsRight
-- a predecessor function -- | a predecessor function
goBack :: Loc a -> Err (Loc a) goBack :: Loc a -> Err (Loc a)
goBack s@(Loc (t,p)) = case goLeft s of goBack s@(Loc (t,p)) = case goLeft s of
Ok s' -> downRight s' Ok s' -> downRight s'
@@ -183,7 +222,7 @@ mapSubtreesM f t = do
ts' <- mapM (mapSubtreesM f) ts ts' <- mapM (mapSubtreesM f) ts
return $ Tr (x, 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 :: (a -> a) -> Loc a -> Loc a
changeRoot f loc = case loc of changeRoot f loc = case loc of
Loc (Tr (a,ts),Top) -> Loc (Tr (f a,ts),Top) 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 nthSubtree n (Tr (a,ts)) = ts !? n
arityTree :: Tr a -> Int arityTree :: Tr a -> Int
arityTree (Tr (_,ts)) = length ts arityTree (Tr (_,ts)) = length ts

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:10 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : EventF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:14 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -15,12 +15,13 @@
module EventF where module EventF where
import AllFudgets import AllFudgets
-- The first string is the name of the key (e.g., "Down" for the down arrow key) -- | The first string is the name of the key (e.g., "Down" for the down arrow key)
--
-- The modifiers list shift, control and alt keys that were active while the -- The modifiers list shift, control and alt keys that were active while the
-- key was pressed. -- key was pressed.
--
-- The last string is the text produced by the key (for keys that produce -- The last string is the text produced by the key (for keys that produce
-- printable characters, empty for control keys). -- printable characters, empty for control keys).
type KeyPress = ((String,[Modifiers]),String) type KeyPress = ((String,[Modifiers]),String)
keyboardF :: F i o -> F i (Either KeyPress o) keyboardF :: F i o -> F i (Either KeyPress o)
@@ -34,10 +35,10 @@ keyboardF fud = idRightSP (concatMapSP post) >^^=< oeventF mask fud
EnterWindowMask, LeaveWindowMask -- because of CTT implementation EnterWindowMask, LeaveWindowMask -- because of CTT implementation
] ]
-- Output events: -- | Output events:
oeventF em fud = eventF em (idLeftF fud) oeventF em fud = eventF em (idLeftF fud)
-- Feed events to argument fudget: -- | Feed events to argument fudget:
eventF eventmask = serCompLeftToRightF . groupF startcmds eventK eventF eventmask = serCompLeftToRightF . groupF startcmds eventK
where where
startcmds = [XCmd $ ChangeWindowAttributes [CWEventMask eventmask], startcmds = [XCmd $ ChangeWindowAttributes [CWEventMask eventmask],

View File

@@ -1,23 +1,21 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : FudgetOps
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:14 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- auxiliary Fudgets for GF syntax editor
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module FudgetOps where module FudgetOps where
import Fudgets import Fudgets
-- auxiliary Fudgets for GF syntax editor
-- save and display -- save and display
showAndSaveF fud = (writeFileF >+< textWindowF) >==< saveF fud showAndSaveF fud = (writeFileF >+< textWindowF) >==< saveF fud
@@ -35,7 +33,7 @@ saveSP contents = getSP $ \msg -> case msg of
textWindowF = writeOutputF textWindowF = writeOutputF
-- to replace stringInputF by a pop-up slot behind a button -- | to replace stringInputF by a pop-up slot behind a button
popupStringInputF :: String -> String -> String -> F String String popupStringInputF :: String -> String -> String -> F String String
popupStringInputF label deflt msg = popupStringInputF label deflt msg =
mapF snd mapF snd

View File

@@ -1,18 +1,18 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : UnicodeF
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module UnicodeF where module UnicodeF (fudlogueWriteU) where
import Fudgets import Fudgets
import Operations import Operations

View File

@@ -1,18 +1,25 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : AbsCompute
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- computation in abstract syntax w.r.t. explicit definitions.
--
-- old GF computation; to be updated
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module AbsCompute where module AbsCompute (LookDef,
compute,
computeAbsTerm,
computeAbsTermIn,
beta
) where
import Operations import Operations
@@ -24,16 +31,13 @@ import Compute
import Monad (liftM, liftM2) import Monad (liftM, liftM2)
-- computation in abstract syntax w.r.t. explicit definitions.
--- old GF computation; to be updated
compute :: GFCGrammar -> Exp -> Err Exp compute :: GFCGrammar -> Exp -> Err Exp
compute = computeAbsTerm compute = computeAbsTerm
computeAbsTerm :: GFCGrammar -> Exp -> Err Exp computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) [] computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
--- a hack to make compute work on source grammar as well -- | a hack to make compute work on source grammar as well
type LookDef = Ident -> Ident -> Err (Maybe Term) type LookDef = Ident -> Ident -> Err (Maybe Term)
computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Abstract
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,18 +1,19 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : AppPredefined
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.9 $
-- --
-- Predefined function type signatures and definitions. -- Predefined function type signatures and definitions.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module AppPredefined where module AppPredefined (isInPredefined, typPredefined, appPredefined
) where
import Operations import Operations
import Grammar import Grammar

View File

@@ -1,18 +1,18 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Compute
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.13 $
-- --
-- Computation of source terms. Used in compilation and in 'cc' command. -- Computation of source terms. Used in compilation and in @cc@ command.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Compute where module Compute (computeConcrete, computeTerm) where
import Operations import Operations
import Grammar import Grammar
@@ -31,9 +31,8 @@ import AppPredefined
import List (nub,intersperse) import List (nub,intersperse)
import Monad (liftM2, liftM) import Monad (liftM2, liftM)
-- computation of concrete syntax terms into normal form -- | computation of concrete syntax terms into normal form
-- used mainly for partial evaluation -- used mainly for partial evaluation
computeConcrete :: SourceGrammar -> Term -> Err Term computeConcrete :: SourceGrammar -> Term -> Err Term
computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t
@@ -295,8 +294,7 @@ computeTerm gr = comp where
cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs] cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs]
return $ S (T i cs') e return $ S (T i cs') e
-- argument variables cannot be glued -- | argument variables cannot be glued
checkNoArgVars :: Term -> Err Term checkNoArgVars :: Term -> Err Term
checkNoArgVars t = case t of checkNoArgVars t = case t of
Vr (IA _) -> Bad $ glueErrorMsg $ prt t Vr (IA _) -> Bad $ glueErrorMsg $ prt t

View File

@@ -1,18 +1,54 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Grammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.7 $
-- --
-- GF source abstract syntax used internally in compilation. -- GF source abstract syntax used internally in compilation.
--
-- AR 23\/1\/2000 -- 30\/5\/2001 -- 4\/5\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Grammar where module Grammar (SourceGrammar,
SourceModInfo,
SourceModule,
SourceAbs,
SourceRes,
SourceCnc,
Info(..),
Perh,
MPr,
Type,
Cat,
Fun,
QIdent,
Term(..),
Patt(..),
TInfo(..),
Label(..),
MetaSymb(..),
Decl,
Context,
Equation,
Labelling,
Assign,
Case,
Cases,
LocalDef,
Param,
Altern,
Substitution,
Branch(..),
Con,
Trm,
wildPatt,
varLabel
) where
import Str import Str
import Ident import Ident
@@ -21,10 +57,7 @@ import Modules
import Operations import Operations
-- AR 23/1/2000 -- 30/5/2001 -- 4/5/2003 -- | grammar as presented to the compiler
-- grammar as presented to the compiler
type SourceGrammar = MGrammar Ident Option Info type SourceGrammar = MGrammar Ident Option Info
type SourceModInfo = ModInfo Ident Option Info type SourceModInfo = ModInfo Ident Option Info
@@ -35,29 +68,39 @@ type SourceAbs = Module Ident Option Info
type SourceRes = Module Ident Option Info type SourceRes = Module Ident Option Info
type SourceCnc = Module Ident Option Info type SourceCnc = Module Ident Option Info
-- judgements in abstract syntax -- | the constructors are judgements in
--
-- - abstract syntax (/ABS/)
--
-- - resource (/RES/)
--
-- - concrete syntax (/CNC/)
--
-- and indirection to module (/INDIR/)
data Info = data Info =
AbsCat (Perh Context) (Perh [Term]) -- constructors; must be Id or QId -- judgements in abstract syntax
| AbsFun (Perh Type) (Perh Term) -- Yes f = canonical AbsCat (Perh Context) (Perh [Term]) -- ^ (/ABS/) constructors; must be 'Id' or 'QId'
| AbsTrans Term | AbsFun (Perh Type) (Perh Term) -- ^ (/ABS/) 'Yes f' = canonical
| AbsTrans Term -- ^ (/ABS/)
-- judgements in resource -- judgements in resource
| ResParam (Perh [Param]) | ResParam (Perh [Param]) -- ^ (/RES/)
| ResValue (Perh Type) -- to mark parameter constructors for lookup | ResValue (Perh Type) -- ^ (/RES/) to mark parameter constructors for lookup
| ResOper (Perh Type) (Perh Term) | ResOper (Perh Type) (Perh Term) -- ^ (/RES/)
-- judgements in concrete syntax -- judgements in concrete syntax
| CncCat (Perh Type) (Perh Term) MPr -- lindef ini'zed, | CncCat (Perh Type) (Perh Term) MPr -- ^ (/CNC/) lindef ini'zed,
| CncFun (Maybe (Ident,(Context,Type))) (Perh Term) MPr -- type info added at TC | CncFun (Maybe (Ident,(Context,Type))) (Perh Term) MPr -- (/CNC/) type info added at 'TC'
-- indirection to module Ident; the Bool says if canonical -- indirection to module Ident
| AnyInd Bool Ident | AnyInd Bool Ident -- ^ (/INDIR/) the 'Bool' says if canonical
deriving (Read, Show) deriving (Read, Show)
type Perh a = Perhaps a Ident -- to express indirection to other module -- | to express indirection to other module
type Perh a = Perhaps a Ident
type MPr = Perhaps Term Ident -- printname -- | printname
type MPr = Perhaps Term Ident
type Type = Term type Type = Term
type Cat = QIdent type Cat = QIdent
@@ -66,80 +109,81 @@ type Fun = QIdent
type QIdent = (Ident,Ident) type QIdent = (Ident,Ident)
data Term = data Term =
Vr Ident -- variable Vr Ident -- ^ variable
| Cn Ident -- constant | Cn Ident -- ^ constant
| Con Ident -- constructor | Con Ident -- ^ constructor
| EData -- to mark in definition that a fun is a constructor | EData -- ^ to mark in definition that a fun is a constructor
| Sort String -- basic type | Sort String -- ^ basic type
| EInt Int -- integer literal | EInt Int -- ^ integer literal
| K String -- string literal or token: "foo" | K String -- ^ string literal or token: @\"foo\"@
| Empty -- the empty string [] | Empty -- ^ the empty string @[]@
| App Term Term -- application: f a | App Term Term -- ^ application: @f a@
| Abs Ident Term -- abstraction: \x -> b | Abs Ident Term -- ^ abstraction: @\x -> b@
| Meta MetaSymb -- metavariable: ?i (only parsable: ? = ?0) | Meta MetaSymb -- ^ metavariable: @?i@ (only parsable: ? = ?0)
| Prod Ident Term Term -- function type: (x : A) -> B | Prod Ident Term Term -- ^ function type: @(x : A) -> B@
| Eqs [Equation] -- abstraction by cases: fn {x y -> b ; z u -> c} | Eqs [Equation] -- ^ abstraction by cases: @fn {x y -> b ; z u -> c}@
-- only used in internal representation -- only used in internal representation
| Typed Term Term -- type-annotated term | Typed Term Term -- ^ type-annotated term
--
-- below this only for concrete syntax -- /below this, the constructors are only for concrete syntax/
| RecType [Labelling] -- record type: { p : A ; ...} | RecType [Labelling] -- ^ record type: @{ p : A ; ...}@
| R [Assign] -- record: { p = a ; ...} | R [Assign] -- ^ record: @{ p = a ; ...}@
| P Term Label -- projection: r.p | P Term Label -- ^ projection: @r.p@
| ExtR Term Term -- extension: R ** {x : A} (both types and terms) | ExtR Term Term -- ^ extension: @R ** {x : A}@ (both types and terms)
| Table Term Term -- table type: P => A | Table Term Term -- ^ table type: @P => A@
| T TInfo [Case] -- table: table {p => c ; ...} | T TInfo [Case] -- ^ table: @table {p => c ; ...}@
| TSh TInfo [Cases] -- table with discjunctive patters (only back end opt) | TSh TInfo [Cases] -- ^ table with discjunctive patters (only back end opt)
| V Type [Term] -- table given as course of values: table T [c1 ; ... ; cn] | V Type [Term] -- ^ table given as course of values: @table T [c1 ; ... ; cn]@
| S Term Term -- selection: t ! p | S Term Term -- ^ selection: @t ! p@
| Let LocalDef Term -- local definition: let {t : T = a} in b | Let LocalDef Term -- ^ local definition: @let {t : T = a} in b@
| Alias Ident Type Term -- constant and its definition, used in inlining | Alias Ident Type Term -- ^ constant and its definition, used in inlining
| Q Ident Ident -- qualified constant from a package | Q Ident Ident -- ^ qualified constant from a package
| QC Ident Ident -- qualified constructor from a package | QC Ident Ident -- ^ qualified constructor from a package
| C Term Term -- concatenation: s ++ t | C Term Term -- ^ concatenation: @s ++ t@
| Glue Term Term -- agglutination: s + t | Glue Term Term -- ^ agglutination: @s + t@
| FV [Term] -- alternatives in free variation: variants { s ; ... } | FV [Term] -- ^ alternatives in free variation: @variants { s ; ... }@
| Alts (Term, [(Term, Term)]) -- alternatives by prefix: pre {t ; s/c ; ...} | Alts (Term, [(Term, Term)]) -- ^ alternatives by prefix: @pre {t ; s\/c ; ...}@
| Strs [Term] -- conditioning prefix strings: strs {s ; ...} | Strs [Term] -- ^ conditioning prefix strings: @strs {s ; ...}@
--
--- these three are obsolete -- /below this, the last three constructors are obsolete/
| LiT Ident -- linearization type | LiT Ident -- ^ linearization type
| Ready Str -- result of compiling; not to be parsed ... | Ready Str -- ^ result of compiling; not to be parsed ...
| Computed Term -- result of computing: not to be reopened nor parsed | Computed Term -- ^ result of computing: not to be reopened nor parsed
deriving (Read, Show, Eq, Ord) deriving (Read, Show, Eq, Ord)
data Patt = data Patt =
PC Ident [Patt] -- constructor pattern: C p1 ... pn C PC Ident [Patt] -- ^ constructor pattern: @C p1 ... pn@ @C@
| PP Ident Ident [Patt] -- package constructor pattern: P.C p1 ... pn P.C | PP Ident Ident [Patt] -- ^ package constructor pattern: @P.C p1 ... pn@ @P.C@
| PV Ident -- variable pattern: x | PV Ident -- ^ variable pattern: @x@
| PW -- wild card pattern: _ | PW -- ^ wild card pattern: @_@
| PR [(Label,Patt)] -- record pattern: {r = p ; ...} -- only concrete | PR [(Label,Patt)] -- ^ record pattern: @{r = p ; ...}@ -- only concrete
| PString String -- string literal pattern: "foo" -- only abstract | PString String -- ^ string literal pattern: @\"foo\"@ -- only abstract
| PInt Int -- integer literal pattern: 12 -- only abstract | PInt Int -- ^ integer literal pattern: @12@ -- only abstract
| PT Type Patt -- type-annotated pattern | PT Type Patt -- ^ type-annotated pattern
deriving (Read, Show, Eq, Ord) deriving (Read, Show, Eq, Ord)
-- to guide computation and type checking of tables -- | to guide computation and type checking of tables
data TInfo = data TInfo =
TRaw -- received from parser; can be anything TRaw -- ^ received from parser; can be anything
| TTyped Type -- type annontated, but can be anything | TTyped Type -- ^ type annontated, but can be anything
| TComp Type -- expanded | TComp Type -- ^ expanded
| TWild Type -- just one wild card pattern, no need to expand | TWild Type -- ^ just one wild card pattern, no need to expand
deriving (Read, Show, Eq, Ord) deriving (Read, Show, Eq, Ord)
-- | record label
data Label = data Label =
LIdent String LIdent String
| LVar Int | LVar Int
deriving (Read, Show, Eq, Ord) -- record label deriving (Read, Show, Eq, Ord)
newtype MetaSymb = MetaSymb Int deriving (Read, Show, Eq, Ord) newtype MetaSymb = MetaSymb Int deriving (Read, Show, Eq, Ord)
@@ -158,10 +202,11 @@ type Altern = (Term, [(Term, Term)])
type Substitution = [(Ident, Term)] type Substitution = [(Ident, Term)]
-- branches à la Alfa -- | branches à la Alfa
newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read) newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
type Con = Ident --- type Con = Ident ---
varLabel :: Int -> Label
varLabel = LVar varLabel = LVar
wildPatt :: Patt wildPatt :: Patt

View File

@@ -1,15 +1,17 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Lockfield
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- Creating and using lock fields in reused resource grammars. -- Creating and using lock fields in reused resource grammars.
--
-- AR 8\/2\/2005 detached from 'compile/MkResource'
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where module Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where
@@ -21,8 +23,6 @@ import PrGrammar
import Operations import Operations
-- AR 8/2/2005 detached from compile/MkResource
lockRecType :: Ident -> Type -> Err Type lockRecType :: Ident -> Type -> Err Type
lockRecType c t@(RecType rs) = lockRecType c t@(RecType rs) =
let lab = lockLabel c in let lab = lockLabel c in

View File

@@ -1,18 +1,35 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : LookAbs
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.12 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module LookAbs where module LookAbs (GFCGrammar,
lookupAbsDef,
lookupFunType,
lookupCatContext,
lookupTransfer,
isPrimitiveFun,
lookupRef,
refsForType,
funRulesOf,
allCatsOf,
allBindCatsOf,
funsForType,
funsOnType,
funsOnTypeFs,
allDefs,
lookupFunTypeSrc,
lookupCatContextSrc
) where
import Operations import Operations
import qualified GFC as C import qualified GFC as C
@@ -62,8 +79,7 @@ lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
_ -> prtBad "unknown category" c _ -> prtBad "unknown category" c
_ -> Bad $ prt m +++ "is not an abstract module" _ -> Bad $ prt m +++ "is not an abstract module"
-- lookup for transfer function: transfer-module-name, category name -- | lookup for transfer function: transfer-module-name, category name
lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term
lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
mi <- lookupModule gr m mi <- lookupModule gr m
@@ -77,7 +93,7 @@ lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
_ -> Bad $ prt m +++ "is not a transfer module" _ -> Bad $ prt m +++ "is not a transfer module"
---- should be revised (20/9/2003) -- | should be revised (20\/9\/2003)
isPrimitiveFun :: GFCGrammar -> Fun -> Bool isPrimitiveFun :: GFCGrammar -> Fun -> Bool
isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
Ok (Just (Eqs [])) -> True -- is canonical Ok (Just (Eqs [])) -> True -- is canonical
@@ -85,8 +101,7 @@ isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
_ -> True -- has no definition _ -> True -- has no definition
-- looking up refinement terms -- | looking up refinement terms
lookupRef :: GFCGrammar -> Binds -> Term -> Err Val lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
lookupRef gr binds at = case at of lookupRef gr binds at = case at of
Q m f -> lookupFunType gr m f >>= return . vClos Q m f -> lookupFunType gr m f >>= return . vClos
@@ -147,8 +162,7 @@ allDefs gr = [((i,c),d) | (i, ModMod m) <- modules gr,
isModAbs m, isModAbs m,
(c, C.AbsFun _ d) <- tree2list (jments m)] (c, C.AbsFun _ d) <- tree2list (jments m)]
-- this is needed at compile time -- | this is needed at compile time
lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type
lookupFunTypeSrc gr m c = do lookupFunTypeSrc gr m c = do
mi <- lookupModule gr m mi <- lookupModule gr m
@@ -161,6 +175,7 @@ lookupFunTypeSrc gr m c = do
_ -> prtBad "cannot find type of" c _ -> prtBad "cannot find type of" c
_ -> Bad $ prt m +++ "is not an abstract module" _ -> Bad $ prt m +++ "is not an abstract module"
-- | this is needed at compile time
lookupCatContextSrc :: Grammar -> Ident -> Ident -> Err Context lookupCatContextSrc :: Grammar -> Ident -> Ident -> Err Context
lookupCatContextSrc gr m c = do lookupCatContextSrc gr m c = do
mi <- lookupModule gr m mi <- lookupModule gr m

View File

@@ -1,18 +1,29 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Lookup
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.12 $
-- --
-- Lookup in source (concrete and resource) when compiling. -- Lookup in source (concrete and resource) when compiling.
--
-- lookup in resource and concrete in compiling; for abstract, use 'Look'
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Lookup where module Lookup (lookupResDef,
lookupResType,
lookupParams,
lookupParamValues,
lookupFirstTag,
allParamValues,
lookupAbsDef,
lookupLincat,
opersForType
) where
import Operations import Operations
import Abstract import Abstract
@@ -22,8 +33,6 @@ import Lockfield
import List (nub) import List (nub)
import Monad import Monad
-- lookup in resource and concrete in compiling; for abstract, use Look
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term
lookupResDef gr = look True where lookupResDef gr = look True where
look isTop m c = do look isTop m c = do

View File

@@ -1,15 +1,15 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : MMacros
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- some more abstractions on grammars, esp. for Edit
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module MMacros where module MMacros where
@@ -27,8 +27,6 @@ import Macros
import Monad import Monad
-- some more abstractions on grammars, esp. for Edit
nodeTree (Tr (n,_)) = n nodeTree (Tr (n,_)) = n
argsTree (Tr (_,ts)) = ts argsTree (Tr (_,ts)) = ts
@@ -69,7 +67,7 @@ changeMetaSubst f (N (b,a,v,(c,m),x)) = N (b,a,v,(c, f m),x)
changeAtom :: (Atom -> Atom) -> TrNode -> TrNode changeAtom :: (Atom -> Atom) -> TrNode -> TrNode
changeAtom f (N (b,a,v,(c,m),x)) = N (b,f a,v,(c, m),x) changeAtom f (N (b,a,v,(c,m),x)) = N (b,f a,v,(c, m),x)
------ on the way to Edit -- * on the way to Edit
uTree :: Tree uTree :: Tree
uTree = Tr (uNode, []) -- unknown tree uTree = Tr (uNode, []) -- unknown tree
@@ -139,7 +137,7 @@ substTerm ss g c = case c of
metaSubstExp :: MetaSubst -> [(Meta,Exp)] metaSubstExp :: MetaSubst -> [(Meta,Exp)]
metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst] metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst]
-- belong here rather than to computation -- * belong here rather than to computation
substitute :: [Var] -> Substitution -> Exp -> Err Exp substitute :: [Var] -> Substitution -> Exp -> Err Exp
substitute v s = return . substTerm v s substitute v s = return . substTerm v s
@@ -245,7 +243,7 @@ fun2wrap oldvars ((fun,i),typ) exp = do
let vars = mkFreshVars (length cont) oldvars let vars = mkFreshVars (length cont) oldvars
return $ mkAbs vars $ if n==i then exp else mExp return $ mkAbs vars $ if n==i then exp else mExp
-- weak heuristics: sameness of value category -- | weak heuristics: sameness of value category
compatType :: Val -> Type -> Bool compatType :: Val -> Type -> Bool
compatType v t = errVal True $ do compatType v t = errVal True $ do
cat1 <- val2cat v cat1 <- val2cat v
@@ -269,8 +267,7 @@ identVar (Vr x) = return x
identVar _ = Bad "not a variable" identVar _ = Bad "not a variable"
-- light-weight rename for user interaction; also change names of internal vars -- | light-weight rename for user interaction; also change names of internal vars
qualifTerm :: Ident -> Term -> Term qualifTerm :: Ident -> Term -> Term
qualifTerm m = qualif [] where qualifTerm m = qualif [] where
qualif xs t = case t of qualif xs t = case t of
@@ -287,8 +284,7 @@ string2var s = case s of
c:'_':i -> identV (readIntArg i,[c]) --- c:'_':i -> identV (readIntArg i,[c]) ---
_ -> zIdent s _ -> zIdent s
-- reindex variables so that they tell nesting depth level -- | reindex variables so that they tell nesting depth level
reindexTerm :: Term -> Term reindexTerm :: Term -> Term
reindexTerm = qualif (0,[]) where reindexTerm = qualif (0,[]) where
qualif dg@(d,g) t = case t of qualif dg@(d,g) t = case t of

View File

@@ -1,15 +1,19 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Macros
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:12 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.17 $
-- --
-- Macros for constructing and analysing source code terms. -- Macros for constructing and analysing source code terms.
--
-- operations on terms and types not involving lookup in or reference to grammars
--
-- AR 7\/12\/1999 - 9\/5\/2000 -- 4\/6\/2001
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Macros where module Macros where
@@ -23,10 +27,6 @@ import PrGrammar
import Monad (liftM) import Monad (liftM)
import Char (isDigit) import Char (isDigit)
-- AR 7/12/1999 - 9/5/2000 -- 4/6/2001
-- operations on terms and types not involving lookup in or reference to grammars
firstTypeForm :: Type -> Err (Context, Type) firstTypeForm :: Type -> Err (Context, Type)
firstTypeForm t = case t of firstTypeForm t = case t of
Prod x a b -> do Prod x a b -> do
@@ -366,7 +366,7 @@ varX i = identV (i,"x")
mkFreshVar :: [Ident] -> Ident mkFreshVar :: [Ident] -> Ident
mkFreshVar olds = varX (maxVarIndex olds + 1) mkFreshVar olds = varX (maxVarIndex olds + 1)
-- trying to preserve a given symbol -- | trying to preserve a given symbol
mkFreshVarX :: [Ident] -> Ident -> Ident mkFreshVarX :: [Ident] -> Ident -> Ident
mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x
@@ -376,22 +376,22 @@ maxVarIndex = maximum . ((-1):) . map varIndex
mkFreshVars :: Int -> [Ident] -> [Ident] mkFreshVars :: Int -> [Ident] -> [Ident]
mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]] mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]]
--- quick hack for refining with var in editor -- | quick hack for refining with var in editor
freshAsTerm :: String -> Term freshAsTerm :: String -> Term
freshAsTerm s = Vr (varX (readIntArg s)) freshAsTerm s = Vr (varX (readIntArg s))
-- create a terminal for concrete syntax -- | create a terminal for concrete syntax
string2term :: String -> Term string2term :: String -> Term
string2term = ccK string2term = ccK
ccK = K ccK = K
ccC = C ccC = C
-- create a terminal from identifier -- | create a terminal from identifier
ident2terminal :: Ident -> Term ident2terminal :: Ident -> Term
ident2terminal = ccK . prIdent ident2terminal = ccK . prIdent
-- create a constant -- | create a constant
string2CnTrm :: String -> Term string2CnTrm :: String -> Term
string2CnTrm = Cn . zIdent string2CnTrm = Cn . zIdent
@@ -441,7 +441,7 @@ mkFreshMetasInTrm metas = fst . rms minMeta where
_ -> (trm,meta) _ -> (trm,meta)
minMeta = if null metas then 0 else (maximum (map metaSymbInt metas) + 1) minMeta = if null metas then 0 else (maximum (map metaSymbInt metas) + 1)
-- decides that a term has no metavariables -- | decides that a term has no metavariables
isCompleteTerm :: Term -> Bool isCompleteTerm :: Term -> Bool
isCompleteTerm t = case t of isCompleteTerm t = case t of
Meta _ -> False Meta _ -> False
@@ -492,7 +492,7 @@ redirectTerm n t = case t of
Q _ f -> Q n f Q _ f -> Q n f
_ -> composSafeOp (redirectTerm n) t _ -> composSafeOp (redirectTerm n) 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 :: Term -> Err [[(Label,Term)]]
allLinFields trm = case unComputed trm of allLinFields trm = case unComputed trm of
---- R rs -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good ---- R rs -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good
@@ -502,24 +502,24 @@ allLinFields trm = case unComputed trm of
return $ concat lts return $ concat lts
_ -> prtBad "fields can only be sought in a record not in" trm _ -> prtBad "fields can only be sought in a record not in" trm
---- deprecated -- | deprecated
isLinLabel l = case l of isLinLabel l = case l of
LIdent ('s':cs) | all isDigit cs -> True LIdent ('s':cs) | all isDigit cs -> True
_ -> False _ -> 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 :: Term -> [([Patt],Term)]
allCaseValues trm = case unComputed trm of allCaseValues trm = case unComputed trm of
T _ cs -> [(p:ps, t) | (p,t0) <- cs, (ps,t) <- allCaseValues t0] T _ cs -> [(p:ps, t) | (p,t0) <- cs, (ps,t) <- allCaseValues t0]
_ -> [([],trm)] _ -> [([],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 :: Term -> Err [[(Label,[([Patt],Term)])]]
allLinValues trm = do allLinValues trm = do
lts <- allLinFields trm lts <- allLinFields trm
mapM (mapPairsM (return . allCaseValues)) lts mapM (mapPairsM (return . allCaseValues)) lts
-- to mark str parts of fields in a record f by a function f -- | to mark str parts of fields in a record f by a function f
markLinFields :: (Term -> Term) -> Term -> Term markLinFields :: (Term -> Term) -> Term -> Term
markLinFields f t = case t of markLinFields f t = case t of
R r -> R $ map mkField r R r -> R $ map mkField r
@@ -530,7 +530,7 @@ markLinFields f t = case t of
T i cs -> T i [(p, mkTbl v) | (p,v) <- cs] T i cs -> T i [(p, mkTbl v) | (p,v) <- cs]
_ -> f t _ -> f t
-- to get a string from a term that represents a sequence of terminals -- | to get a string from a term that represents a sequence of terminals
strsFromTerm :: Term -> Err [Str] strsFromTerm :: Term -> Err [Str]
strsFromTerm t = case unComputed t of strsFromTerm t = case unComputed t of
K s -> return [str s] K s -> return [str s]
@@ -558,13 +558,12 @@ strsFromTerm t = case unComputed t of
Alias _ _ d -> strsFromTerm d --- should not be needed... Alias _ _ d -> strsFromTerm d --- should not be needed...
_ -> prtBad "cannot get Str from term" t _ -> prtBad "cannot get Str from term" t
-- to print an Str-denoting term as a string; if the term is of wrong type, the error msg -- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg
stringFromTerm :: Term -> String stringFromTerm :: Term -> String
stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm
-- to define compositional term functions -- | to define compositional term functions
composSafeOp :: (Term -> Term) -> Term -> Term composSafeOp :: (Term -> Term) -> Term -> Term
composSafeOp op trm = case composOp (mkMonadic op) trm of composSafeOp op trm = case composOp (mkMonadic op) trm of
Ok t -> t Ok t -> t
@@ -572,6 +571,7 @@ composSafeOp op trm = case composOp (mkMonadic op) trm of
where where
mkMonadic f = return . f mkMonadic f = return . f
-- | to define compositional term functions
composOp :: Monad m => (Term -> m Term) -> Term -> m Term composOp :: Monad m => (Term -> m Term) -> Term -> m Term
composOp co trm = composOp co trm =
case trm of case trm of
@@ -686,8 +686,7 @@ collectOp co trm = case trm of
Strs tt -> concatMap co tt Strs tt -> concatMap co tt
_ -> [] -- covers K, Vr, Cn, Sort, Ready _ -> [] -- covers K, Vr, Cn, Sort, Ready
-- to find the word items in a term -- | to find the word items in a term
wordsInTerm :: Term -> [String] wordsInTerm :: Term -> [String]
wordsInTerm trm = filter (not . null) $ case trm of wordsInTerm trm = filter (not . null) $ case trm of
K s -> [s] K s -> [s]
@@ -705,8 +704,7 @@ defaultLinType = mkRecType linLabel [typeStr]
metaTerms :: [Term] metaTerms :: [Term]
metaTerms = map (Meta . MetaSymb) [0..] metaTerms = map (Meta . MetaSymb) [0..]
-- from GF1, 20/9/2003 -- | from GF1, 20\/9\/2003
isInOneType :: Type -> Bool isInOneType :: Type -> Bool
isInOneType t = case t of isInOneType t = case t of
Prod _ a b -> a == b Prod _ a b -> a == b

View File

@@ -1,18 +1,21 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PatternMatch
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- (Description of the module) -- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module PatternMatch where module PatternMatch (matchPattern,
testOvershadow,
findMatch
) where
import Operations import Operations
import Grammar import Grammar
@@ -23,8 +26,6 @@ import PrGrammar
import List import List
import Monad import Monad
-- pattern matching for both concrete and abstract syntax. AR -- 16/6/2003
matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution) matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution)
matchPattern pts term = matchPattern pts term =
@@ -105,7 +106,7 @@ varsOfPatt p = case p of
PT _ q -> varsOfPatt q PT _ q -> varsOfPatt q
_ -> [] _ -> []
-- to search matching parameter combinations in tables -- | to search matching parameter combinations in tables
isMatchingForms :: [Patt] -> [Term] -> Bool isMatchingForms :: [Patt] -> [Term] -> Bool
isMatchingForms ps ts = all match (zip ps ts') where isMatchingForms ps ts = all match (zip ps ts') where
match (PC c cs, (Cn d, ds)) = c == d && isMatchingForms cs ds match (PC c cs, (Cn d, ds)) = c == d && isMatchingForms cs ds

View File

@@ -1,18 +1,36 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : PrGrammar
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.11 $
-- --
-- (Description of the module) -- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
--
-- printing and prettyprinting class
--
-- 8\/1\/2004:
-- Usually followed principle: 'prt_' for displaying in the editor, 'prt'
-- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree',
-- only the former is ever needed.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module PrGrammar where module PrGrammar (Print(..),
prtBad,
prGrammar, prModule,
prContext, prParam,
prQIdent, prQIdent_,
prRefinement, prTermOpt,
prt_Tree, prMarkedTree, prTree,
tree2string, prprTree,
prConstrs, prConstraints,
prMetaSubst, prEnv, prMSubst,
prExp, prPatt, prOperSignature
) where
import Operations import Operations
import Zipper import Zipper
@@ -30,15 +48,14 @@ import Str
import List (intersperse) import List (intersperse)
-- AR 7/12/1999 - 1/4/2000 - 10/5/2003
-- printing and prettyprinting class
class Print a where class Print a where
prt :: a -> String prt :: a -> String
prt2 :: a -> String -- printing with parentheses, if needed -- | printing with parentheses, if needed
prpr :: a -> [String] -- pretty printing prt2 :: a -> String
prt_ :: a -> String -- printing without ident qualifications -- | pretty printing
prpr :: a -> [String]
-- | printing without ident qualifications
prt_ :: a -> String
prt2 = prt prt2 = prt
prt_ = prt prt_ = prt
prpr = return . prt prpr = return . prt
@@ -48,11 +65,14 @@ class Print a where
--- in writing grammars to a file. For some constructs, e.g. prMarkedTree, --- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
--- only the former is ever needed. --- only the former is ever needed.
-- to show terms etc in error messages -- | to show terms etc in error messages
prtBad :: Print a => String -> a -> Err b prtBad :: Print a => String -> a -> Err b
prtBad s a = Bad (s +++ prt a) prtBad s a = Bad (s +++ prt a)
prGrammar :: SourceGrammar -> String
prGrammar = P.printTree . trGrammar prGrammar = P.printTree . trGrammar
prModule :: (Ident, SourceModInfo) -> String
prModule = P.printTree . trModule prModule = P.printTree . trModule
instance Print Term where instance Print Term where
@@ -108,7 +128,7 @@ instance Print a => Print (Tr a) where
prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees) prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t) prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
-- we cannot define the method prt_ in this way -- | we cannot define the method prt_ in this way
prt_Tree :: Tree -> String prt_Tree :: Tree -> String
prt_Tree = prt_ . tree2exp prt_Tree = prt_ . tree2exp
@@ -133,7 +153,8 @@ prMarkedTree = prf 1 where
prTree :: Tree -> [String] prTree :: Tree -> [String]
prTree = prMarkedTree . mapTr (\n -> (n,False)) prTree = prMarkedTree . mapTr (\n -> (n,False))
-- a pretty-printer for parsable output -- | a pretty-printer for parsable output
tree2string :: Tree -> String
tree2string = unlines . prprTree tree2string = unlines . prprTree
prprTree :: Tree -> [String] prprTree :: Tree -> [String]
@@ -204,8 +225,7 @@ prQIdent (m,f) = prt m ++ "." ++ prt f
prQIdent_ :: QIdent -> String prQIdent_ :: QIdent -> String
prQIdent_ (_,f) = prt f prQIdent_ (_,f) = prt f
-- print terms without qualifications -- | print terms without qualifications
prExp :: Term -> String prExp :: Term -> String
prExp e = case e of prExp e = case e of
App f a -> pr1 f +++ pr2 a App f a -> pr1 f +++ pr2 a
@@ -232,10 +252,12 @@ prPatt p = case p of
A.PC _ (_:_) -> prParenth $ prPatt p A.PC _ (_:_) -> prParenth $ prPatt p
_ -> prPatt p _ -> prPatt p
-- option -strip strips qualifications -- | option @-strip@ strips qualifications
prTermOpt :: Options -> Term -> String
prTermOpt opts = if oElem nostripQualif opts then prt else prExp prTermOpt opts = if oElem nostripQualif opts then prt else prExp
--- to get rid of brackets in the editor -- | to get rid of brackets in the editor
prRefinement :: Term -> String
prRefinement t = case t of prRefinement t = case t of
Q m c -> prQIdent (m,c) Q m c -> prQIdent (m,c)
QC m c -> prQIdent (m,c) QC m c -> prQIdent (m,c)

View File

@@ -1,18 +1,20 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Refresh
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.5 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Refresh where module Refresh (refreshTerm, refreshTermN,
refreshModule
) where
import Operations import Operations
import Grammar import Grammar

View File

@@ -1,25 +1,23 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : ReservedWords
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- reserved words of GF. (c) Aarne Ranta 19\/3\/2002 under Gnu GPL.
-- modified by Markus Forsberg 9\/4.
-- modified by AR 12\/6\/2003 for GF2 and GFC
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ReservedWords (isResWord, isResWordGFC) where module ReservedWords (isResWord, isResWordGFC) where
import List import List
-- reserved words of GF. (c) Aarne Ranta 19/3/2002 under Gnu GPL
-- modified by Markus Forsberg 9/4.
-- modified by AR 12/6/2003 for GF2 and GFC
isResWord :: String -> Bool isResWord :: String -> Bool
isResWord s = isInTree s resWordTree isResWord s = isInTree s resWordTree

View File

@@ -1,18 +1,24 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : TC
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.7 $
-- --
-- (Description of the module) -- Thierry Coquand's type checking algorithm that creates a trace
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module TC where module TC (AExp(..),
Theory,
checkExp,
inferExp,
eqVal,
whnf
) where
import Operations import Operations
import Abstract import Abstract
@@ -20,8 +26,6 @@ import AbsCompute
import Monad import Monad
-- Thierry Coquand's type checking algorithm that creates a trace
data AExp = data AExp =
AVr Ident Val AVr Ident Val
| ACn QIdent Val | ACn QIdent Val

View File

@@ -1,18 +1,37 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : TypeCheck
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.13 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module TypeCheck where module TypeCheck (-- * top-level type checking functions; TC should not be called directly.
annotate, annotateIn,
justTypeCheck, checkIfValidExp,
reduceConstraints,
splitConstraints,
possibleConstraints,
reduceConstraintsNode,
performMetaSubstNode,
-- * some top-level batch-mode checkers for the compiler
justTypeCheckSrc,
grammar2theorySrc,
checkContext,
checkTyp,
checkEquation,
checkConstrs,
editAsTermCommand,
exp2termCommand,
exp2termlistCommand,
tree2termlistCommand
) where
import Operations import Operations
import Zipper import Zipper
@@ -35,14 +54,14 @@ import List (nub) ---
annotate :: GFCGrammar -> Exp -> Err Tree annotate :: GFCGrammar -> Exp -> Err Tree
annotate gr exp = annotateIn gr [] exp Nothing annotate gr exp = annotateIn gr [] exp Nothing
-- type check in empty context, return a list of constraints -- | type check in empty context, return a list of constraints
justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints
justTypeCheck gr e v = do justTypeCheck gr e v = do
(_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
constrs1 <- reduceConstraints (lookupAbsDef gr) 0 constrs0 constrs1 <- reduceConstraints (lookupAbsDef gr) 0 constrs0
return $ fst $ splitConstraints gr constrs1 return $ fst $ splitConstraints gr constrs1
-- type check in empty context, return the expression itself if valid -- | type check in empty context, return the expression itself if valid
checkIfValidExp :: GFCGrammar -> Exp -> Err Exp checkIfValidExp :: GFCGrammar -> Exp -> Err Exp
checkIfValidExp gr e = do checkIfValidExp gr e = do
(_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e (_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e
@@ -63,11 +82,11 @@ annotateIn gr gamma exp = maybe (infer exp) (check exp) where
c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c
aexp2tree (a,c') aexp2tree (a,c')
-- invariant way of creating TCEnv from context -- | invariant way of creating TCEnv from context
initTCEnv gamma = initTCEnv gamma =
(length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma)
-- process constraints after eqVal by computing by defs -- | process constraints after eqVal by computing by defs
reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints
reduceConstraints look i = liftM concat . mapM redOne where reduceConstraints look i = liftM concat . mapM redOne where
redOne (u,v) = do redOne (u,v) = do
@@ -92,7 +111,7 @@ computeVal look v = case v of
compt = computeAbsTermIn look compt = computeAbsTermIn look
compv = computeVal look compv = computeVal look
-- take apart constraints that have the form (? <> t), usable as solutions -- | take apart constraints that have the form (? <> t), usable as solutions
splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst) splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst)
splitConstraints gr = splitConstraintsGen (lookupAbsDef gr) splitConstraints gr = splitConstraintsGen (lookupAbsDef gr)
@@ -141,10 +160,11 @@ performMetaSubstNode subst n@(N (b,a,v,(c,m),s)) = let
Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst
_ -> composSafeOp metaSubstExp e _ -> composSafeOp metaSubstExp e
reduceConstraintsNode :: GFCGrammar -> TrNode -> TrNode
reduceConstraintsNode gr = changeConstrs red where reduceConstraintsNode gr = changeConstrs red where
red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs
-- weak heuristic to narrow down menus; not used for TC. 15/11/2001 -- | weak heuristic to narrow down menus; not used for TC. 15\/11\/2001.
-- the age-old method from GF 0.9 -- the age-old method from GF 0.9
possibleConstraints :: GFCGrammar -> Constraints -> Bool possibleConstraints :: GFCGrammar -> Constraints -> Bool
possibleConstraints gr = and . map (possibleConstraint gr) possibleConstraints gr = and . map (possibleConstraint gr)

View File

@@ -1,18 +1,21 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Unify
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.3 $
-- --
-- (Description of the module) -- (c) Petri Mäenpää & Aarne Ranta, 1998--2001
--
-- brute-force adaptation of the old-GF program AR 21\/12\/2001 ---
-- the only use is in 'TypeCheck.splitConstraints'
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Unify where module Unify (unifyVal) where
import Abstract import Abstract
@@ -20,11 +23,6 @@ import Operations
import List (partition) import List (partition)
-- (c) Petri Mäenpää & Aarne Ranta, 1998--2001
-- brute-force adaptation of the old-GF program AR 21/12/2001 ---
-- the only use is in TypeCheck.splitConstraints
unifyVal :: Constraints -> Err (Constraints,MetaSubst) unifyVal :: Constraints -> Err (Constraints,MetaSubst)
unifyVal cs0 = do unifyVal cs0 = do
let (cs1,cs2) = partition notSolvable cs0 let (cs1,cs2) = partition notSolvable cs0

View File

@@ -1,18 +1,27 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Values
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Values where module Values (-- * values used in TC type checking
Exp, Val(..), Env,
-- * annotated tree used in editing
Tree, TrNode(..), Atom(..), Binds, Constraints, MetaSubst,
-- * for TC
valAbsInt, valAbsString, vType,
isPredefCat,
cType, cPredefAbs, cInt, cString,
eType, tree2exp, loc2treeFocus
) where
import Operations import Operations
import Zipper import Zipper
@@ -45,19 +54,28 @@ type MetaSubst = [(MetaSymb,Val)]
-- for TC -- for TC
valAbsInt, valAbsString :: Val valAbsInt :: Val
valAbsInt = VCn (cPredefAbs, cInt) valAbsInt = VCn (cPredefAbs, cInt)
valAbsString :: Val
valAbsString = VCn (cPredefAbs, cString) valAbsString = VCn (cPredefAbs, cString)
vType :: Val vType :: Val
vType = VType vType = VType
cType,cPredefAbs,cInt,cString :: Ident cType :: Ident
cType = identC "Type" --- #0 cType = identC "Type" --- #0
cPredefAbs :: Ident
cPredefAbs = identC "PredefAbs" cPredefAbs = identC "PredefAbs"
cInt :: Ident
cInt = identC "Int" cInt = identC "Int"
cString :: Ident
cString = identC "String" cString = identC "String"
isPredefCat :: Ident -> Bool
isPredefCat c = elem c [cInt,cString] isPredefCat c = elem c [cInt,cString]
eType :: Exp eType :: Exp

View File

@@ -1,18 +1,23 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : CheckM
-- Maintainer : (Maintainer) -- Maintainer : (Maintainer)
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CheckM where module CheckM (Check,
checkError, checkCond, checkWarn, checkUpdate, checkInContext,
checkUpdates, checkReset, checkResets, checkGetContext,
checkLookup, checkStart, checkErr, checkVal, checkIn,
prtFail
) where
import Operations import Operations
import Grammar import Grammar

View File

@@ -1,22 +1,21 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Comments
-- Maintainer : (Maintainer) -- Maintainer : (Maintainer)
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:13 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- comment removal
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Comments ( remComments module Comments ( remComments
) where ) 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 :: String -> String
remComments s = remComments s =
case s of case s of

View File

@@ -1,18 +1,26 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Ident
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:14 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Ident where module Ident (-- * Identifiers
Ident(..), prIdent,
identC, identV, identA, identAV, identW,
argIdent, strVar, wildIdent, isWildIdent,
newIdent, mkIdent, varIndex,
-- * refreshing identifiers
IdState, initIdStateN, initIdState,
lookVar, refVar, refVarPlus
) where
import Operations import Operations
-- import Monad -- import Monad
@@ -23,8 +31,8 @@ import Operations
data Ident = data Ident =
IC String -- ^ raw identifier after parsing, resolved in Rename IC String -- ^ raw identifier after parsing, resolved in Rename
| IW -- ^ wildcard | IW -- ^ wildcard
--
-- below this line: internal representation never returned by the parser -- below this constructor: internal representation never returned by the parser
| IV (Int,String) -- ^ /INTERNAL/ variable | IV (Int,String) -- ^ /INTERNAL/ variable
| IA (String,Int) -- ^ /INTERNAL/ argument of cat at position | IA (String,Int) -- ^ /INTERNAL/ argument of cat at position
| IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position | IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position

View File

@@ -1,18 +1,39 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Modules
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.19 $
-- --
-- Datastructures and functions for modules, common to GF and GFC. -- Datastructures and functions for modules, common to GF and GFC.
--
-- AR 29\/4\/2003
--
-- The same structure will be used in both source code and canonical.
-- The parameters tell what kind of data is involved.
-- Invariant: modules are stored in dependency order
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Modules where module Modules (MGrammar(..), ModInfo(..), Module(..), ModuleType(..), MReuseType(..),
extendm, updateMGrammar, updateModule, replaceJudgements,
addOpenQualif, flagsModule, allFlags, mapModules,
MainGrammar(..), MainConcreteSpec(..), OpenSpec(..), OpenQualif(..),
oSimple, oQualif,
ModuleStatus(..),
openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar,
allExtends, allExtendsPlus, allExtensions, searchPathModule, addModule,
emptyMGrammar, emptyModInfo, emptyModule,
IdentM(..),
typeOfModule, abstractOfConcrete, abstractModOfConcrete,
lookupModule, lookupModuleType, lookupModMod, lookupInfo,
allModMod, isModAbs, isModRes, isModCnc, isModTrans,
sameMType, isCompilableModule, isCompleteModule,
allAbstracts, greatestAbstract, allResources, greatestResource, allConcretes
) where
import Ident import Ident
import Option import Option
@@ -46,25 +67,23 @@ data Module i f a = Module {
} }
deriving Show deriving Show
-- encoding the type of the module -- | encoding the type of the module
data ModuleType i = data ModuleType i =
MTAbstract MTAbstract
| MTTransfer (OpenSpec i) (OpenSpec i) | MTTransfer (OpenSpec i) (OpenSpec i)
| MTResource | MTResource
| MTConcrete i | MTConcrete i
-- ^ up to this, also used in GFC. Below, source only.
-- up to this, also used in GFC. Below, source only.
| MTInterface | MTInterface
| MTInstance i | MTInstance i
| MTReuse (MReuseType i) | MTReuse (MReuseType i)
| MTUnion (ModuleType i) [(i,[i])] --- not meant to be recursive | MTUnion (ModuleType i) [(i,[i])] -- ^ not meant to be recursive
deriving (Eq,Show) deriving (Eq,Show)
data MReuseType i = MRInterface i | MRInstance i i | MRResource i data MReuseType i = MRInterface i | MRInstance i i | MRResource i
deriving (Show,Eq) deriving (Show,Eq)
-- previously: single inheritance -- | previously: single inheritance
extendm :: Module i f a -> Maybe i extendm :: Module i f a -> Maybe i
extendm m = case extends m of extendm m = case extends m of
[i] -> Just i [i] -> Just i
@@ -72,7 +91,7 @@ extendm m = case extends m of
-- destructive update -- destructive update
--- dep order preserved since old cannot depend on new -- | dep order preserved since old cannot depend on new
updateMGrammar :: Ord i => MGrammar i f a -> MGrammar i f a -> MGrammar i f a updateMGrammar :: Ord i => MGrammar i f a -> MGrammar i f a -> MGrammar i f a
updateMGrammar old new = MGrammar $ updateMGrammar old new = MGrammar $
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns [(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
@@ -114,8 +133,8 @@ data MainGrammar i = MainGrammar {
data MainConcreteSpec i = MainConcreteSpec { data MainConcreteSpec i = MainConcreteSpec {
concretePrintname :: i , concretePrintname :: i ,
concreteName :: i , concreteName :: i ,
transferIn :: Maybe (OpenSpec i) , -- if there is an in-transfer transferIn :: Maybe (OpenSpec i) , -- ^ if there is an in-transfer
transferOut :: Maybe (OpenSpec i) -- if there is an out-transfer transferOut :: Maybe (OpenSpec i) -- ^ if there is an out-transfer
} }
deriving Show deriving Show
@@ -147,7 +166,7 @@ allOpens m = case mtype m of
MTTransfer a b -> a : b : opens m MTTransfer a b -> a : b : opens m
_ -> opens m _ -> opens m
-- initial dependency list -- | initial dependency list
depPathModule :: Ord i => Module i f a -> [OpenSpec i] depPathModule :: Ord i => Module i f a -> [OpenSpec i]
depPathModule m = fors m ++ exts m ++ opens m where depPathModule m = fors m ++ exts m ++ opens m where
fors m = case mtype m of fors m = case mtype m of
@@ -157,7 +176,7 @@ depPathModule m = fors m ++ exts m ++ opens m where
_ -> [] _ -> []
exts m = map oSimple $ extends m exts m = map oSimple $ extends m
-- all dependencies -- | all dependencies
allDepsModule :: Ord i => MGrammar i f a -> Module i f a -> [OpenSpec i] allDepsModule :: Ord i => MGrammar i f a -> Module i f a -> [OpenSpec i]
allDepsModule gr m = iterFix add os0 where allDepsModule gr m = iterFix add os0 where
os0 = depPathModule m os0 = depPathModule m
@@ -165,7 +184,7 @@ allDepsModule gr m = iterFix add os0 where
m <- depPathModule n] m <- depPathModule n]
mods = modules gr mods = modules gr
-- select just those modules that a given one depends on, including itself -- | select just those modules that a given one depends on, including itself
partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor] partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
where where
@@ -175,7 +194,7 @@ partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
_ -> [i] ---- ModWith? _ -> [i] ---- ModWith?
-- all modules that a module extends, directly or indirectly -- | all modules that a module extends, directly or indirectly
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i] allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
allExtends gr i = case lookupModule gr i of allExtends gr i = case lookupModule gr i of
Ok (ModMod m) -> case extends m of Ok (ModMod m) -> case extends m of
@@ -183,7 +202,7 @@ allExtends gr i = case lookupModule gr i of
is -> i : concatMap (allExtends gr) is is -> i : concatMap (allExtends gr) is
_ -> [] _ -> []
-- this plus that an instance extends its interface -- | this plus that an instance extends its interface
allExtendsPlus :: (Show i,Ord i) => MGrammar i f a -> i -> [i] allExtendsPlus :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
allExtendsPlus gr i = case lookupModule gr i of allExtendsPlus gr i = case lookupModule gr i of
Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m) Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
@@ -191,7 +210,7 @@ allExtendsPlus gr i = case lookupModule gr i of
where where
exts m = extends m ++ [j | MTInstance j <- [mtype m]] exts m = extends m ++ [j | MTInstance j <- [mtype m]]
-- conversely: all modules that extend a given module, incl. instances of interface -- | conversely: all modules that extend a given module, incl. instances of interface
allExtensions :: (Show i,Ord i) => MGrammar i f a -> i -> [i] allExtensions :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
allExtensions gr i = case lookupModule gr i of allExtensions gr i = case lookupModule gr i of
Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
@@ -201,11 +220,11 @@ allExtensions gr i = case lookupModule gr i of
|| elem (MTInstance i) [mtype m]] || elem (MTInstance i) [mtype m]]
mods = [(j,m) | (j,ModMod m) <- modules gr] mods = [(j,m) | (j,ModMod m) <- modules gr]
-- initial search path: the nonqualified dependencies -- | initial search path: the nonqualified dependencies
searchPathModule :: Ord i => Module i f a -> [i] searchPathModule :: Ord i => Module i f a -> [i]
searchPathModule m = [i | OSimple _ i <- depPathModule m] searchPathModule m = [i | OSimple _ i <- depPathModule m]
-- a new module can safely be added to the end, since nothing old can depend on it -- | a new module can safely be added to the end, since nothing old can depend on it
addModule :: Ord i => addModule :: Ord i =>
MGrammar i f a -> i -> ModInfo i f a -> MGrammar i f a MGrammar i f a -> i -> ModInfo i f a -> MGrammar i f a
addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)]) addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
@@ -219,8 +238,7 @@ emptyModInfo = ModMod emptyModule
emptyModule :: Module i f a emptyModule :: Module i f a
emptyModule = Module MTResource MSComplete [] [] [] NT emptyModule = Module MTResource MSComplete [] [] [] NT
-- we store the module type with the identifier -- | we store the module type with the identifier
data IdentM i = IdentM { data IdentM i = IdentM {
identM :: i , identM :: i ,
typeM :: ModuleType i typeM :: ModuleType i
@@ -310,38 +328,38 @@ sameMType m n = case (m,n) of
(MTInterface,MTResource) -> True (MTInterface,MTResource) -> True
_ -> m == n _ -> m == n
-- don't generate code for interfaces and for incomplete modules -- | don't generate code for interfaces and for incomplete modules
isCompilableModule m = case m of isCompilableModule m = case m of
ModMod m -> case mtype m of ModMod m -> case mtype m of
MTInterface -> False MTInterface -> False
_ -> mstatus m == MSComplete _ -> mstatus m == MSComplete
_ -> False --- _ -> False ---
-- interface and "incomplete M" are not complete -- | interface and "incomplete M" are not complete
isCompleteModule :: (Eq i) => Module i f a -> Bool isCompleteModule :: (Eq i) => Module i f a -> Bool
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-- all abstract modules -- | all abstract modules
allAbstracts :: Eq i => MGrammar i f a -> [i] allAbstracts :: Eq i => MGrammar i f a -> [i]
allAbstracts gr = [i | (i,ModMod m) <- modules gr, mtype m == MTAbstract] allAbstracts gr = [i | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
-- the last abstract in dependency order (head of list) -- | the last abstract in dependency order (head of list)
greatestAbstract :: Eq i => MGrammar i f a -> Maybe i greatestAbstract :: Eq i => MGrammar i f a -> Maybe i
greatestAbstract gr = case allAbstracts gr of greatestAbstract gr = case allAbstracts gr of
[] -> Nothing [] -> Nothing
a:_ -> return a a:_ -> return a
-- all resource modules -- | all resource modules
allResources :: MGrammar i f a -> [i] allResources :: MGrammar i f a -> [i]
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m] allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
-- the greatest resource in dependency order -- | the greatest resource in dependency order
greatestResource :: MGrammar i f a -> Maybe i greatestResource :: MGrammar i f a -> Maybe i
greatestResource gr = case allResources gr of greatestResource gr = case allResources gr of
[] -> Nothing [] -> Nothing
a -> return $ head a a -> return $ head a
-- all concretes for a given abstract -- | all concretes for a given abstract
allConcretes :: Eq i => MGrammar i f a -> i -> [i] allConcretes :: Eq i => MGrammar i f a -> i -> [i]
allConcretes gr a = [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a] allConcretes gr a = [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a]

View File

@@ -1,18 +1,72 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : Option
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.19 $
-- --
-- Options and flags used in GF shell commands and files. -- Options and flags used in GF shell commands and files.
--
-- The types 'Option' and 'Options' should be kept abstract, but:
--
-- - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
--
-- - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Option where module Option (-- * all kinds of options, should be kept abstract
Option(..), Options(..), OptFun, OptFunId,
noOptions, iOpt, aOpt, iOpts, oArg, oElem, eqOpt,
getOptVal, getOptInt, optIntOrAll, optIntOrN, optIntOrOne,
changeOptVal, addOption, addOptions, concatOptions,
removeOption, removeOptions, options, unionOptions,
-- * parsing options, with prefix pre (e.g. \"-\")
getOptions, pOption, isOption,
-- * printing options, without prefix
prOpt, prOpts,
-- * a suggestion for option names
-- ** parsing
strictParse, forgiveParse, ignoreParse, literalParse,
rawParse, firstParse, dontParse,
-- ** grammar formats
showAbstr, showXML, showOld, showLatex, showFullForm,
showEBNF, showCF, showWords, showOpts,
isCompiled, isHaskell, noCompOpers, retainOpers, defaultGrOpts,
newParser, noCF, checkCirc, noCheckCirc, lexerByNeed,
-- ** linearization
allLin, firstLin, distinctLin, dontLin, showRecord, showStruct,
xmlLin, latexLin, tableLin, defaultLinOpts, useUTF8, showLang, withMetas,
-- ** other
beVerbose, showInfo, beSilent, emitCode, getHelp, doMake, doBatch,
notEmitCode, makeMulti, beShort, wholeGrammar, makeFudget, byLines, byWords,
analMorpho, doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
stripQualif, nostripQualif, showAll, fromSource,
-- ** mainly for stand-alone
useUnicode, optCompute, optCheck, optParaphrase, forJava,
-- ** for edit session
allLangs, absView,
-- ** options that take arguments
useTokenizer, useUntokenizer, useParser, withFun, firstCat, gStartCat,
useLanguage, useResource, speechLanguage, useFont,
grammarFormat, grammarPrinter, filterString, termCommand, transferFun,
forForms, menuDisplay, sizeDisplay, typeDisplay,
noDepTypes, extractGr, pathList, uniCoding,
useName, useAbsName, useCncName, useResName, useFile, useOptimizer,
markLin, markOptXML, markOptJava, markOptStruct, markOptFocus,
-- ** refinement order
nextRefine, firstRefine, lastRefine,
-- ** Boolean flags
flagYes, flagNo, caseYesNo,
-- ** integer flags
flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees
) where
import List (partition) import List (partition)
import Char (isDigit) import Char (isDigit)
@@ -25,11 +79,20 @@ newtype Options = Opts [Option] deriving (Eq,Show,Read)
noOptions :: Options noOptions :: Options
noOptions = Opts [] noOptions = Opts []
iOpt o = Opt (o,[]) -- simple option -o iOpt :: String -> Option
aOpt o a = Opt (o,[a]) -- option with argument -o=a iOpt o = Opt (o,[])
-- ^ simple option -o
aOpt :: String -> String -> Option
aOpt o a = Opt (o,[a])
-- ^ option with argument -o=a
iOpts :: [Option] -> Options
iOpts = Opts iOpts = Opts
oArg s = s -- value of option argument oArg :: String -> String
oArg s = s
-- ^ value of option argument
oElem :: Option -> Options -> Bool oElem :: Option -> Options -> Bool
oElem o (Opts os) = elem o os oElem o (Opts os) = elem o os

View File

@@ -1,26 +1,28 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : ReadFiles
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.19 $
-- --
-- Decide what files to read as function of dependencies and time stamps. -- Decide what files to read as function of dependencies and time stamps.
--
-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
--
-- to find all files that have to be read, put them in dependency order, and
-- decide which files need recompilation. Name @file.gf@ is returned for them,
-- and @file.gfc@ or @file.gfr@ otherwise.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ReadFiles module ReadFiles (-- * Heading 1
--- where getAllFiles,fixNewlines,ModName,getOptionsFromFile,
-- * Heading 2
-- gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile
( ) where
--
getAllFiles,fixNewlines,ModName,getOptionsFromFile,
--
gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile) where
import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime) import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
@@ -34,12 +36,6 @@ import Monad
import List import List
import Directory import Directory
-- make analysis for GF grammar modules. AR 11/6/2003--24/2/2004
-- to find all files that have to be read, put them in dependency order, and
-- decide which files need recompilation. Name file.gf is returned for them,
-- and file.gfc or file.gfr otherwise.
type ModName = String type ModName = String
type ModEnv = [(ModName,ModTime)] type ModEnv = [(ModName,ModTime)]
@@ -292,15 +288,14 @@ lexs s = x:xs where
(x,y) = head $ lex s (x,y) = head $ lex s
xs = if null y then [] else lexs y xs = if null y then [] else lexs y
-- options can be passed to the compiler by comments in --#, in the main file -- | options can be passed to the compiler by comments in @--#@, in the main file
getOptionsFromFile :: FilePath -> IO Options getOptionsFromFile :: FilePath -> IO Options
getOptionsFromFile file = do getOptionsFromFile file = do
s <- readFileIf file s <- readFileIf file
let ls = filter (isPrefixOf "--#") $ lines s let ls = filter (isPrefixOf "--#") $ lines s
return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
-- check if old GF file -- | check if old GF file
isOldFile :: FilePath -> IO Bool isOldFile :: FilePath -> IO Bool
isOldFile f = do isOldFile f = do
s <- readFileIf f s <- readFileIf f
@@ -312,7 +307,7 @@ isOldFile f = do
-- old GF tolerated newlines in quotes. No more supported! -- | old GF tolerated newlines in quotes. No more supported!
fixNewlines :: String -> String fixNewlines :: String -> String
fixNewlines s = case s of fixNewlines s = case s of
'"':cs -> '"':mk cs '"':cs -> '"':mk cs

View File

@@ -1,18 +1,60 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : UseIO
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:16 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.8 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module UseIO where module UseIO (prOptCPU,
putCPU,
putPoint,
putPoint',
readFileIf,
FileName,
InitPath,
FullPath,
getFilePath,
readFileIfPath,
doesFileExistPath,
extendPathEnv,
pFilePaths,
prefixPathName,
justInitPath,
nameAndSuffix,
unsuffixFile, fileBody,
fileSuffix,
justFileName,
suffixFile,
justModuleName,
getLineWell,
putStrFlush,
putStrLnFlush,
-- * a generic quiz session
QuestionsAndAnswers,
teachDialogue,
-- * IO monad with error; adapted from state monad
IOE(..),
appIOE,
ioe,
ioeIO,
ioeErr,
ioeBad,
useIOE,
foldIOE,
putStrLnE,
putStrE,
putPointE,
putPointEVerb,
readFileIOE,
readFileLibraryIOE
) where
import Operations import Operations
import Arch (prCPU) import Arch (prCPU)
@@ -35,7 +77,7 @@ putIfVerbW opts msg =
then putStr (' ' : msg) then putStr (' ' : msg)
else return () else return ()
-- obsolete with IOE monad -- | obsolete with IOE monad
errIO :: a -> Err a -> IO a errIO :: a -> Err a -> IO a
errIO = errOptIO noOptions errIO = errOptIO noOptions
@@ -95,7 +137,7 @@ doesFileExistPath paths file = do
mpfile <- ioeIO $ getFilePath paths file mpfile <- ioeIO $ getFilePath paths file
return $ maybe False (const True) mpfile return $ maybe False (const True) mpfile
-- path in environment variable has lower priority -- | path in environment variable has lower priority
extendPathEnv :: String -> [FilePath] -> IO [FilePath] extendPathEnv :: String -> [FilePath] -> IO [FilePath]
extendPathEnv var ps = do extendPathEnv var ps = do
s <- catch (getEnv var) (const (return "")) s <- catch (getEnv var) (const (return ""))
@@ -243,7 +285,7 @@ putPointE opts msg act = do
return a return a
-} -}
-- forces verbosity -- | forces verbosity
putPointEVerb :: Options -> String -> IOE a -> IOE a putPointEVerb :: Options -> String -> IOE a -> IOE a
putPointEVerb opts = putPointE (addOption beVerbose opts) putPointEVerb opts = putPointE (addOption beVerbose opts)
@@ -252,9 +294,10 @@ readFileIOE :: FilePath -> IOE (String)
readFileIOE f = ioe $ catch (readFile f >>= return . return) readFileIOE f = ioe $ catch (readFile f >>= return . return)
(\_ -> return (Bad (reportOn f))) where (\_ -> return (Bad (reportOn f))) where
reportOn f = "File " ++ f ++ " not found." reportOn f = "File " ++ f ++ " not found."
-- like readFileIOE but look also in the GF library if file not found -- | like readFileIOE but look also in the GF library if file not found
-- intended semantics: if file is not found, try $GF_LIB_PATH/file --
-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
-- (even if file is an absolute path, but this should always fail) -- (even if file is an absolute path, but this should always fail)
-- it returns not only contents of the file, but also the path used -- it returns not only contents of the file, but also the path used
readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String) readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String)
@@ -281,7 +324,7 @@ readFileLibraryIOE ini f =
_ -> ini ++ file -- relative path name _ -> ini ++ file -- relative path name
-- example -- | example
koeIOE :: IO () koeIOE :: IO ()
koeIOE = useIOE () $ do koeIOE = useIOE () $ do
s <- ioeIO $ getLine s <- ioeIO $ getLine

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.32 $
-- --
-- GF shell command interpreter. -- GF shell command interpreter.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.13 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.34 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.9 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.17 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.22 $
-- --
-- The datatype of shell commands and the list of their options. -- The datatype of shell commands and the list of their options.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.6 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.4 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------

View File

@@ -1,16 +1,3 @@
----------------------------------------------------------------------
-- |
-- Module : (Module)
-- Maintainer : (Maintainer)
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date $
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module AbsGF where module AbsGF where

View File

@@ -1,13 +1,13 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : GrammarToSource
-- Maintainer : (Maintainer) -- Maintainer : AR
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date $ -- > CVS $Date: 2005/02/18 19:21:20 $
-- > CVS $Author $ -- > CVS $Author: peb $
-- > CVS $Revision $ -- > CVS $Revision: 1.16 $
-- --
-- From internal source syntax to BNFC-generated (used for printing). -- From internal source syntax to BNFC-generated (used for printing).
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -21,9 +21,9 @@ import Option
import qualified AbsGF as P import qualified AbsGF as P
import Ident import Ident
-- AR 13/5/2003 -- | AR 13\/5\/2003
--
-- translate internal to parsable and printable source -- translate internal to parsable and printable source
trGrammar :: SourceGrammar -> P.Grammar trGrammar :: SourceGrammar -> P.Grammar
trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes

Some files were not shown because too many files have changed in this diff Show More