summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/CFGM/PrintCFGrammar.hs15
-rw-r--r--src/GF/Conversion/GFC.hs8
-rw-r--r--src/GF/Conversion/GFCtoSimple.hs5
-rw-r--r--src/GF/Conversion/SimpleToFinite.hs7
-rw-r--r--src/GF/Conversion/SimpleToMCFG/Nondet.hs8
-rw-r--r--src/GF/Conversion/Types.hs166
-rw-r--r--src/GF/Formalism/Utilities.hs77
-rw-r--r--src/GF/Parsing/GFC.hs6
-rw-r--r--src/GF/Parsing/MCFG/Incremental2.hs4
-rw-r--r--src/GF/Parsing/MCFG/PInfo.hs8
-rw-r--r--src/GF/Parsing/MCFG/ViaCFG.hs2
-rw-r--r--src/GF/Shell/ShellCommands.hs8
-rw-r--r--src/GF/UseGrammar/Custom.hs14
-rw-r--r--src/haddock/haddock-script.csh26
14 files changed, 231 insertions, 123 deletions
diff --git a/src/GF/CFGM/PrintCFGrammar.hs b/src/GF/CFGM/PrintCFGrammar.hs
index 504c21e6c..bf7d8320a 100644
--- a/src/GF/CFGM/PrintCFGrammar.hs
+++ b/src/GF/CFGM/PrintCFGrammar.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:21:19 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.17 $
+-- > CVS $Date: 2005/05/13 12:40:18 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.18 $
--
-- Handles printing a CFGrammar in CFGM format.
-----------------------------------------------------------------------------
@@ -23,6 +23,7 @@ import GF.Infra.Modules
import qualified GF.Conversion.GFC as Cnv
import GF.Infra.Print (prt)
import GF.Formalism.CFG (CFRule(..))
+import qualified GF.Formalism.Utilities as GU
import qualified GF.Conversion.Types as GT
import qualified GF.CFGM.AbsCFG as AbsCFG
import GF.Formalism.Utilities (Symbol(..))
@@ -66,7 +67,7 @@ cfGrammarToCFGM gr i start = AbsCFG.Grammar (identToCFGMIdent i) flags (map rule
where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
-ruleToCFGMRule (CFRule c rhs (GT.Name fun profile))
+ruleToCFGMRule (CFRule c rhs (GU.Name fun profile))
= AbsCFG.Rule fun' p' c' rhs'
where
fun' = identToFun fun
@@ -74,10 +75,10 @@ ruleToCFGMRule (CFRule c rhs (GT.Name fun profile))
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
-profileToCFGMProfile :: [GT.Profile a] -> AbsCFG.Profile
+profileToCFGMProfile :: [GU.Profile a] -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map cnvProfile
- where cnvProfile (GT.Unify ns) = AbsCFG.Ints $ map fromIntegral ns
- cnvProfile (GT.Constant a) = AbsCFG.Ints []
+ where cnvProfile (GU.Unify ns) = AbsCFG.Ints $ map fromIntegral ns
+ cnvProfile (GU.Constant a) = AbsCFG.Ints []
-- FIXME: this should be replaced with a new constructor in 'AbsCFG'
identToCFGMIdent :: Ident -> AbsCFG.Ident
diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index 9e0b58be1..d0b3ea9d3 100644
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 09:28:43 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
--
-- All conversions from GFC
-----------------------------------------------------------------------------
@@ -22,7 +22,7 @@ import GF.Infra.Ident (Ident, identC)
import GF.Formalism.GCFG (Rule(..), Abstract(..))
import GF.Formalism.SimpleGFC (decl2cat)
import GF.Formalism.CFG (CFRule(..))
-import GF.Formalism.Utilities (symbol)
+import GF.Formalism.Utilities (symbol, name2fun)
import GF.Conversion.Types
import qualified GF.Conversion.GFCtoSimple as G2S
@@ -89,7 +89,7 @@ gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
Rule (Abs decl decls name) _ <- gfc2simple gr ]
-abstract2prolog :: [Abstract SCat Fun] -> String
+abstract2prolog :: [Abstract SCat Fun] -> String
abstract2prolog gr = skvatt_hdr ++ concatMap abs2pl gr
where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++
"\"" ++ prt fun ++ "\".\n"
diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
index e7a3789a4..c238eabfe 100644
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ b/src/GF/Conversion/GFCtoSimple.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/10 12:52:06 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
+-- > CVS $Revision: 1.8 $
--
-- Converting GFC to SimpleGFC
--
@@ -24,6 +24,7 @@ import qualified GF.Canon.AbsGFC as A
import qualified GF.Infra.Ident as I
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
+import GF.Formalism.Utilities
import GF.Conversion.Types
import GF.Canon.GFC (CanonGrammar)
diff --git a/src/GF/Conversion/SimpleToFinite.hs b/src/GF/Conversion/SimpleToFinite.hs
index 7cefd7844..adc8afc78 100644
--- a/src/GF/Conversion/SimpleToFinite.hs
+++ b/src/GF/Conversion/SimpleToFinite.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:21:54 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
--
-- Calculating the finiteness of each type in a grammar
-----------------------------------------------------------------------------
@@ -19,6 +19,7 @@ import GF.Infra.Print
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
+import GF.Formalism.Utilities
import GF.Conversion.Types
import GF.Data.SortedList
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
index 12db9511c..22970bd84 100644
--- a/src/GF/Conversion/SimpleToMCFG/Nondet.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 09:28:44 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
--
-- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
-- Afterwards, the grammar has to be extended with coercion functions,
@@ -60,7 +60,7 @@ convertGrammar rules = traceCalcFirst rules' $
convertRule :: SRule -> [ERule] -- CnvMonad ERule
convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term))) =
--- | prt(name2fun fun) `elem`
+-- | prt(name2fun fun) `elem`
-- words "UseCl PosTP TPast ASimul SPredV IndefOneNP DefOneNP UseN2 mother_N2 jump_V" =
if notLongerThan maxNrRules rules
then tracePrt ("SimpeToMCFG.Nondet - MCFG rules for " ++ prt fun) (prt . length) $
@@ -78,7 +78,7 @@ convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term))) =
catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
-- checkLinRec argsPaths catPaths newLinRec
return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec)
-convertRule _ = [] -- failure
+convertRule _ = [] -- failure
----------------------------------------------------------------------
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index c233ca69d..03afeab40 100644
--- a/src/GF/Conversion/Types.hs
+++ b/src/GF/Conversion/Types.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 09:28:44 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
--
-- All possible instantiations of different grammar formats used in conversion from GFC
-----------------------------------------------------------------------------
@@ -27,6 +27,7 @@ import GF.Infra.Print
import GF.Data.Assoc
import Control.Monad (foldM)
+import Data.List (intersperse)
----------------------------------------------------------------------
-- * basic (leaf) types
@@ -38,67 +39,7 @@ type Token = String
-- ** function names
type Fun = Ident.Ident
-data Name = Name Fun [Profile (SyntaxForest Fun)]
- deriving (Eq, Ord, Show)
-
-name2fun :: Name -> Fun
-name2fun (Name fun _) = fun
-
-----------------------------------------------------------------------
--- * profiles
-
--- | A profile is a simple representation of a function on a number of arguments.
--- We only use lists of profiles
-data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
- -- 'Unify []' will become a metavariable,
- -- 'Unify [a,b]' means that the arguments are equal,
- | Constant a
- deriving (Eq, Ord, Show)
-
-instance Functor Profile where
- fmap f (Constant a) = Constant (f a)
- fmap f (Unify xs) = Unify xs
-
--- | a function name where the profile does not contain arguments
--- (i.e. denoting a constant, not a function)
-constantNameToForest :: Name -> SyntaxForest Fun
-constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile]
- where unConstant (Constant a) = a
- unConstant (Unify []) = FMeta
- unConstant _ = error $ "constantNameToForest: the profile should not contain arguments: " ++ prt name
-
--- | profile application; we need some way of unifying a list of arguments
-applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
-applyProfile unify profile args = map apply profile
- where apply (Unify xs) = unify $ map (args !!) xs
- apply (Constant a) = a
-
--- | monadic profile application
-applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
-applyProfileM unify profile args = mapM apply profile
- where apply (Unify xs) = unify $ map (args !!) xs
- apply (Constant a) = return a
-
--- | profile composition:
---
--- > applyProfile u z (ps `composeProfiles` qs) args
--- > ==
--- > applyProfile u z ps (applyProfile u z qs args)
---
--- compare with function composition
---
--- > (p . q) arg
--- > ==
--- > p (q arg)
---
--- Note that composing an 'Constant' with two or more arguments returns an error
--- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
-composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
-composeProfiles ps qs = map compose ps
- where compose (Unify [x]) = qs !! x
- compose (Unify xs) = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
- compose constant = constant
-
+type Name = NameProfile Fun
----------------------------------------------------------------------
@@ -191,12 +132,99 @@ instance Print MCat where
instance Print CCat where
prt (CCat cat label) = prt cat ++ prt label
-instance Print Name where
- prt (Name fun profile) = prt fun ++ prt profile
-instance Print a => Print (Profile a) where
- prt (Unify []) = "?"
- prt (Unify args) = prtSep "=" args
- prt (Constant a) = prt a
+----------------------------------------------------------------------
+-- * other printing facilities
+
+-- ** printing grammars as Haskell files
+
+prtHsSGrammar :: SGrammar -> String
+prtHsSGrammar rules = "-- Simple GFC grammar as a Haskell file\n" ++
+ "-- autogenerated from the Grammatical Framework\n\n" ++
+ "import GF.Formalism.GCFG\n" ++
+ "import GF.Formalism.SimpleGFC\n" ++
+ "import GF.Formalism.Utilities\n" ++
+ "--import GF.Conversion.Types\n" ++
+ "import GF.Canon.AbsGFC (CIdent(..), Label(..))\n" ++
+ "import GF.Infra.Ident (Ident(..))\n" ++
+ "\ngrammar :: SimpleGrammar Ident (NameProfile Ident) String\n" ++
+ -- "\ngrammar :: SGrammar\n" ++
+ "grammar = \n\t[ " ++
+ concat (intersperse "\n\t, " (map show rules)) ++
+ "\n\t]\n\n"
+
+prtHsMGrammar :: MGrammar -> String
+prtHsMGrammar rules = "-- Multiple context-free grammar as a Haskell file\n" ++
+ "-- autogenerated from the Grammatical Framework\n\n" ++
+ "import GF.Formalism.GCFG\n" ++
+ "import GF.Formalism.MCFG\n" ++
+ "import GF.Formalism.Utilities\n" ++
+ "\ngrammar :: MCFGrammar String (NameProfile String) String String\n" ++
+ "grammar = \n\t[ " ++
+ concat (intersperse "\n\t, " (map prtHsMRule rules)) ++
+ "\n\t]\n\n"
+ where prtHsMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins)) =
+ show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvHsProfile profiles)))
+ (Cnc (map prt lcat) (map (map prt) lcats) (map cnvHsLin lins)))
+ cnvHsLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
+ prtMArg (cat, lbl, nr) = (prt cat, prt lbl, nr)
+
+prtHsCGrammar :: CGrammar -> String
+prtHsCGrammar rules = "-- Context-free grammar as a Haskell file\n" ++
+ "-- autogenerated from the Grammatical Framework\n\n" ++
+ "import GF.Formalism.CFG\n" ++
+ "import GF.Formalism.Utilities\n" ++
+ "\ngrammar :: CFGrammar String (NameProfile String) String\n" ++
+ "grammar = \n\t[ " ++
+ concat (intersperse "\n\t, " (map prtHsCRule rules)) ++
+ "\n\t]\n\n"
+ where prtHsCRule (CFRule cat syms (Name fun profiles)) =
+ show (CFRule (prt cat) (map (mapSymbol prt id) syms)
+ (Name (prt fun) (map cnvHsProfile profiles)))
+
+cnvHsProfile (Unify args) = Unify args
+cnvHsProfile (Constant forest) = Constant (fmap prt forest)
+
+-- ** printing grammars as Prolog files
+
+prtPlMGrammar :: MGrammar -> String
+prtPlMGrammar rules = ":- op(1100, xfx, ':=').\n" ++
+ ":- op(1000, xfx, '--->').\n" ++
+ ":- op(200, xfx, '@').\n\n" ++
+ "%% Fun/ProfileList : Cat ---> [Cat,...] := [Lbl=SymbolList,...]\n" ++
+ concatMap prtPlMRule rules
+ where prtPlMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc _lcat _lcats lins)) =
+ prtPlQuoted fun ++ "/" ++
+ "[" ++ prtSep "," (map prtPlProfile profiles) ++ "] : " ++
+ prtPlQuoted cat ++ " ---> " ++
+ "[" ++ prtSep ", " (map prtPlQuoted cats) ++ "] := \n" ++
+ "\t[ " ++ prtSep "\n\t, " (map prtLin lins) ++ "\n\t].\n"
+ prtLin (Lin lbl lin) = prtPlQuoted lbl ++ " = " ++
+ "[" ++ prtSep ", " (map prtSymbol lin) ++ "]"
+ prtSymbol (Cat (cat, lbl, nr)) = prtPlQuoted cat ++ "@" ++ show nr ++ "-" ++ prtPlQuoted lbl
+ prtSymbol (Tok tok) = "[" ++ prtPlQuoted tok ++ "]"
+
+prtPlCGrammar :: CGrammar -> String
+prtPlCGrammar rules = ":- op(1000, xfx, '--->').\n\n" ++
+ "%% Fun/ProfileList : Cat ---> [Symbol,...]\n" ++
+ concatMap prtPlCRule rules
+ where prtPlCRule (CFRule cat syms (Name fun profiles)) =
+ prtPlQuoted fun ++ "/" ++
+ "[" ++ prtSep "," (map prtPlProfile profiles) ++ "] : " ++
+ prtPlQuoted cat ++ " ---> " ++
+ "[" ++ prtSep ", " (map prtSymbol syms) ++ "].\n"
+ prtSymbol (Cat cat) = prtPlQuoted cat
+ prtSymbol (Tok tok) = "[" ++ prtPlQuoted tok ++ "]"
+
+prtPlProfile (Unify args) = show args
+prtPlProfile (Constant forest) = prtPlForest forest
+
+prtPlForest (FMeta) = "_META_"
+prtPlForest (FNode fun fss) = prtPlQuoted fun ++ "^" ++ prtFss fss
+ where prtFss fss = "[" ++ prtSep "," (map prtFs fss) ++ "]"
+ prtFs fs = "[" ++ prtSep "," (map prtPlForest fs) ++ "]"
+
+prtPlQuoted str = "'" ++ prt str ++ "'"
+
diff --git a/src/GF/Formalism/Utilities.hs b/src/GF/Formalism/Utilities.hs
index fabb708d1..3948980e1 100644
--- a/src/GF/Formalism/Utilities.hs
+++ b/src/GF/Formalism/Utilities.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:22:14 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
--
-- Basic type declarations and functions for grammar formalisms
-----------------------------------------------------------------------------
@@ -238,6 +238,69 @@ forest2trees (FNode n forests) = map (TNode n) $ forests >>= mapM forest2trees
forest2trees (FMeta) = [TMeta]
+----------------------------------------------------------------------
+-- * profiles
+
+-- | Pairing a rule name with a profile
+data NameProfile a = Name a [Profile (SyntaxForest a)]
+ deriving (Eq, Ord, Show)
+
+name2fun :: NameProfile a -> a
+name2fun (Name fun _) = fun
+
+-- | A profile is a simple representation of a function on a number of arguments.
+-- We only use lists of profiles
+data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
+ -- 'Unify []' will become a metavariable,
+ -- 'Unify [a,b]' means that the arguments are equal,
+ | Constant a
+ deriving (Eq, Ord, Show)
+
+instance Functor Profile where
+ fmap f (Constant a) = Constant (f a)
+ fmap f (Unify xs) = Unify xs
+
+-- | a function name where the profile does not contain arguments
+-- (i.e. denoting a constant, not a function)
+constantNameToForest :: NameProfile a -> SyntaxForest a
+constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile]
+ where unConstant (Constant a) = a
+ unConstant (Unify []) = FMeta
+ unConstant _ = error $ "constantNameToForest: the profile should not contain arguments"
+
+-- | profile application; we need some way of unifying a list of arguments
+applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
+applyProfile unify profile args = map apply profile
+ where apply (Unify xs) = unify $ map (args !!) xs
+ apply (Constant a) = a
+
+-- | monadic profile application
+applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
+applyProfileM unify profile args = mapM apply profile
+ where apply (Unify xs) = unify $ map (args !!) xs
+ apply (Constant a) = return a
+
+-- | profile composition:
+--
+-- > applyProfile u z (ps `composeProfiles` qs) args
+-- > ==
+-- > applyProfile u z ps (applyProfile u z qs args)
+--
+-- compare with function composition
+--
+-- > (p . q) arg
+-- > ==
+-- > p (q arg)
+--
+-- Note that composing an 'Constant' with two or more arguments returns an error
+-- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
+composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
+composeProfiles ps qs = map compose ps
+ where compose (Unify [x]) = qs !! x
+ compose (Unify xs) = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
+ compose constant = constant
+
+
------------------------------------------------------------
-- pretty-printing
@@ -275,4 +338,12 @@ instance (Print s) => Print (SyntaxForest s) where
prt (FMeta) = "?"
prtList = prtAfter "\n"
+instance Print a => Print (Profile a) where
+ prt (Unify []) = "?"
+ prt (Unify args) = prtSep "=" args
+ prt (Constant a) = prt a
+
+instance Print a => Print (NameProfile a) where
+ prt (Name fun profile) = prt fun ++ prt profile
+
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index ec2409515..8f79bab01 100644
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/11 10:28:16 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
--
-- The main parsing module, parsing GFC grammars
-- by translating to simpler formats, such as PMCFG and CFG
@@ -58,7 +58,7 @@ instance Print PInfo where
----------------------------------------------------------------------
-- main parsing function
-parse :: String -- ^ parsing algorithm (mcfg/cfg)
+parse :: String -- ^ parsing algorithm (mcfg or cfg)
-> String -- ^ parsing strategy
-> PInfo -- ^ compiled grammars (mcfg and cfg)
-> Ident.Ident -- ^ abstract module name
diff --git a/src/GF/Parsing/MCFG/Incremental2.hs b/src/GF/Parsing/MCFG/Incremental2.hs
index 0ae6eb926..9d95f0fb0 100644
--- a/src/GF/Parsing/MCFG/Incremental2.hs
+++ b/src/GF/Parsing/MCFG/Incremental2.hs
@@ -92,12 +92,12 @@ data Item c n l t = Active (Abstract c n)
(LinRec c l t)
[RangeRec l]
| Final (Abstract c n) (RangeRec l) [RangeRec l]
- -- | Passive c (RangeRec l)
+ ---- | Passive c (RangeRec l)
deriving (Eq, Ord, Show)
data IKey c l t = Act c l
| ActTok t
- -- | Useless
+ ---- | Useless
| Pass
| Fin
deriving (Eq, Ord, Show)
diff --git a/src/GF/Parsing/MCFG/PInfo.hs b/src/GF/Parsing/MCFG/PInfo.hs
index 3b2603a20..4fbe3e736 100644
--- a/src/GF/Parsing/MCFG/PInfo.hs
+++ b/src/GF/Parsing/MCFG/PInfo.hs
@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 09:28:46 $
+-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
--
-- MCFG parsing, parser information
-----------------------------------------------------------------------------
@@ -76,7 +76,7 @@ rangeRestrictPInfo (pinfo{-::MCFPInfo c n l t-}) inp =
, leftcornerTokens = lctokens
, grammarCats = grammarCats pinfo
, rulesByToken = emptyAssoc -- error "MCFG.PInfo.rulesByToken - no range restriction"
- , rulesWithoutTokens = [] -- error "MCFG.PInfo.rulesByToken - no range restriction"
+ , rulesWithoutTokens = [] -- error "MCFG.PInfo.rulesByToken - no range restriction"
, allRules = allrules -- rrRules (allRules pinfo)
}
@@ -114,7 +114,7 @@ buildMCFPInfo grammar =
namerules = accumAssoc id
[ (name, rule) | rule@(Rule (Abs _ _ name) _) <- allrules ]
topdownrules = accumAssoc id
- [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- allrules ]
+ [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- allrules ]
emptyrules = [ rule | rule@(Rule (Abs _ [] _) _) <- allrules ]
leftcorncats = accumAssoc id
[ (cat, rule) |
diff --git a/src/GF/Parsing/MCFG/ViaCFG.hs b/src/GF/Parsing/MCFG/ViaCFG.hs
index 5007eec20..00fff83e0 100644
--- a/src/GF/Parsing/MCFG/ViaCFG.hs
+++ b/src/GF/Parsing/MCFG/ViaCFG.hs
@@ -161,7 +161,7 @@ convert _ _ = []
----------------------------------------------------------------------------------}
-- FULKOD !
-nrOfCats :: Eq c => MCFG.Lin c l t  -> Int
+nrOfCats :: Eq c => MCFG.Lin c l t -> Int
nrOfCats (MCFG.Lin l syms) = length $ nub [(c, i) | Cat (c, l, i) <- syms]
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index d6a2c8d3e..0bed0e1e5 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/12 10:03:33 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.33 $
+-- > CVS $Date: 2005/05/13 12:40:20 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.34 $
--
-- The datatype of shell commands and the list of their options.
-----------------------------------------------------------------------------
@@ -132,7 +132,7 @@ testValidFlag st co f x = case f of
"parser" -> testInc customParser
-- hack for the -newer parsers: (to be changed in the future)
-- `mplus` testIn (words "mcfg mcfg-bottomup mcfg-topdown cfg cfg-bottomup cfg-topdown bottomup topdown")
- -- if not(null x) && head x `elem` "mc" then return () else Bad ""
+ -- if not(null x) && head x `elem` "mc" then return () else Bad ""
"alts" -> testN
"transform" -> testInc customTermCommand
"filter" -> testInc customStringCommand
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index e1d2dff77..65657ca26 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/12 10:03:33 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.61 $
+-- > CVS $Date: 2005/05/13 12:40:20 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.62 $
--
-- A database for customizable GF shell commands.
--
@@ -75,6 +75,7 @@ import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
import qualified GF.Printing.PrintParser as PrtOld -- OBSOLETE
import qualified GF.Infra.Print as Prt
import qualified GF.Conversion.GFC as Cnv
+import qualified GF.Conversion.Types as CnvTypes
import GF.Canon.GFC
import qualified GF.Canon.MkGFC as MC
@@ -254,6 +255,13 @@ customGrammarPrinter =
,(strCI "cfg", Prt.prt . stateCFG)
,(strCI "pinfo", Prt.prt . statePInfo)
,(strCI "abstract", Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang)
+
+ ,(strCI "simple-haskell", CnvTypes.prtHsSGrammar . Cnv.gfc2simple . stateGrammarLang)
+ ,(strCI "mcfg-haskell", CnvTypes.prtHsMGrammar . stateMCFG)
+ ,(strCI "cfg-haskell", CnvTypes.prtHsCGrammar . stateCFG)
+ -- ,(strCI "simple-prolog", CnvTypes.prtHsSGrammar . Cnv.gfc2simple . stateGrammarLang)
+ ,(strCI "mcfg-prolog", CnvTypes.prtPlMGrammar . stateMCFG)
+ ,(strCI "cfg-prolog", CnvTypes.prtPlCGrammar . stateCFG)
-- obsolete, or only for testing:
,(strCI "abs-pl", Cnv.abstract2prolog . Cnv.gfc2abstract . stateGrammarLang)
,(strCI "cfg-pl", Cnv.cfg2prolog . stateCFG)
diff --git a/src/haddock/haddock-script.csh b/src/haddock/haddock-script.csh
index bafb9afef..77b3761f8 100644
--- a/src/haddock/haddock-script.csh
+++ b/src/haddock/haddock-script.csh
@@ -2,21 +2,19 @@
######################################################################
# Author: Peter Ljunglöf
-# Time-stamp: "2005-03-29, 14:04"
-# CVS $Date: 2005/04/11 13:53:37 $
+# Time-stamp: "2005-05-12, 23:17"
+# CVS $Date: 2005/05/13 12:40:20 $
# CVS $Author: peb $
#
-# a script for producing documentation through Haddock
+# a script for producing documentation through Haddock
######################################################################
-# set base = `pwd`
-set docdir = haddock
-set tempdir = .haddock-temp-files
-set resourcedir = haddock-resources
+set basedir = `pwd`
+set docdir = haddock/html
+set tempdir = haddock/.temp-files
+set resourcedir = haddock/resources
-#set dirs = (. api compile grammar infra shell source canonical useGrammar cf newparsing parsers notrace cfgm speech visualization for-hugs for-ghc)
-
-set files = (`find * -name '*.hs' -not -path 'old-stuff/*' -not -path 'for-*' -not -path 'haddock*'` for-ghc-nofud/*.hs)
+set files = (`find GF -name '*.hs'` GF.hs)
######################################################################
@@ -24,14 +22,14 @@ echo 1. Creating and cleaning Haddock directory
echo -- $docdir
mkdir -p $docdir
-rm -r $docdir/*
+rm -rf $docdir/*
######################################################################
echo
echo 2. Copying Haskell files to temporary directory: $tempdir
-rm -r $tempdir
+rm -rf $tempdir
foreach f ($files)
# echo -- $f
@@ -45,8 +43,8 @@ echo
echo 3. Invoking Haddock
cd $tempdir
-haddock -o ../$docdir -h -t 'Grammatical Framework' $files
-cd ..
+haddock -o $basedir/$docdir -h -t 'Grammatical Framework' $files
+cd $basedir
######################################################################
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 23:03:05 +0000