"Committed_by_peb"

src/GF/CFGM/PrintCFGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:19 $ 
+-- > CVS $Date: 2005/05/13 12:40:18 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
+-- > 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
+    where cnvProfile (GU.Unify ns)   = AbsCFG.Ints $ map fromIntegral ns
-	  cnvProfile (GT.Constant a) = AbsCFG.Ints []
+	  cnvProfile (GU.Constant a) = AbsCFG.Ints []
 	  -- FIXME: this should be replaced with a new constructor in 'AbsCFG'
 
 identToCFGMIdent :: Ident -> AbsCFG.Ident

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"

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)

src/GF/Conversion/SimpleToFinite.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:54 $ 
+-- > CVS $Date: 2005/05/13 12:40:19 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > 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

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
 
 
 ----------------------------------------------------------------------

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)]
+type Name = NameProfile 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
-
 
 
 ----------------------------------------------------------------------
@@ -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 [])   = "?"
+-- * other printing facilities
-    prt (Unify args) = prtSep "=" args
+
-    prt (Constant a) = prt a
+-- ** 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 ++ "'"
+
 
 

src/GF/Formalism/Utilities.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:22:14 $ 
+-- > CVS $Date: 2005/05/13 12:40:19 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > 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
+
 

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

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)

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) | 

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]
 
 

src/GF/Shell/ShellCommands.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/12 10:03:33 $ 
+-- > CVS $Date: 2005/05/13 12:40:20 $ 
--- > CVS $Author: aarne $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.33 $
+-- > 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

src/GF/UseGrammar/Custom.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/12 10:03:33 $ 
+-- > CVS $Date: 2005/05/13 12:40:20 $ 
--- > CVS $Author: aarne $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.61 $
+-- > 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)

src/haddock/haddock-script.csh

@@ -2,21 +2,19 @@
 
 ######################################################################
 # Author: Peter Ljunglöf
-# Time-stamp: "2005-03-29, 14:04"
+# Time-stamp: "2005-05-12, 23:17"
-# CVS $Date: 2005/04/11 13:53:37 $
+# 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 basedir = `pwd`
-set docdir = haddock
+set docdir = haddock/html
-set tempdir = .haddock-temp-files
+set tempdir = haddock/.temp-files
-set resourcedir = haddock-resources
+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 GF -name '*.hs'` GF.hs)
-
-set files = (`find * -name '*.hs' -not -path 'old-stuff/*' -not -path 'for-*' -not -path 'haddock*'` for-ghc-nofud/*.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
+haddock -o $basedir/$docdir -h -t 'Grammatical Framework' $files
-cd ..
+cd $basedir
 
 ######################################################################