summaryrefslogtreecommitdiff
path: root/src/GF/Conversion
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Conversion')
-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
5 files changed, 112 insertions, 82 deletions
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 ++ "'"
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:54:35 +0000