mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-12 06:19:33 -06:00
"Committed_by_peb"
This commit is contained in:
peb
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
@@ -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 ++ "'"
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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) |
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
######################################################################
|
||||
|
||||
|
||||
Reference in New Issue
Block a user