"Committed_by_peb"

1 files changed, 71 insertions, 0 deletions

diff --git a/src/GF/Conversion/Haskell.hs b/src/GF/Conversion/Haskell.hs
new file mode 100644
index 000000000..abe651e1e
--- /dev/null
+++ b/src/GF/Conversion/Haskell.hs
@@ -0,0 +1,71 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Converting/Printing different grammar formalisms in Haskell-readable format
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.Haskell where
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.MCFG
+import GF.Formalism.CFG
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+import GF.Data.Operations ((++++), (+++++))
+import GF.Infra.Print
+
+import Data.List (intersperse)
+
+-- | SimpleGFC to Haskell
+prtSGrammar :: SGrammar -> String
+prtSGrammar rules = "-- Simple GFC grammar as a Haskell file" ++++
+                    "-- Autogenerated from the Grammatical Framework" +++++
+                    "import GF.Formalism.GCFG" ++++
+                    "import GF.Formalism.SimpleGFC" ++++
+                    "import GF.Formalism.Utilities" ++++
+                    "import GF.Canon.AbsGFC (CIdent(..), Label(..))" ++++
+                    "import GF.Infra.Ident (Ident(..))" +++++
+                    "grammar :: SimpleGrammar Ident (NameProfile Ident) String" ++++
+                    "grammar = \n\t[ " ++ 
+                    concat (intersperse "\n\t, " (map show rules)) ++ "\n\t]\n\n"
+
+-- | MCFG to Haskell
+prtMGrammar :: MGrammar -> String
+prtMGrammar rules = "-- Multiple context-free grammar as a Haskell file" ++++
+		    "-- Autogenerated from the Grammatical Framework" +++++
+		    "import GF.Formalism.GCFG" ++++
+		    "import GF.Formalism.MCFG" ++++
+                    "import GF.Formalism.Utilities" +++++
+                    "grammar :: MCFGrammar String (NameProfile String) String String" ++++
+		    "grammar = \n\t[ " ++ 
+		    concat (intersperse "\n\t, " (map prtMRule rules)) ++ "\n\t]\n\n" 
+    where prtMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins)) 
+	      = show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvProfile profiles)))
+		           (Cnc (map prt lcat) (map (map prt) lcats) (map cnvLin lins)))
+	  cnvLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
+	  prtMArg  (cat, lbl, nr) = (prt cat, prt lbl, nr)
+
+-- | CFG to Haskell
+prtCGrammar :: CGrammar -> String
+prtCGrammar rules = "-- Context-free grammar as a Haskell file" ++++
+		    "-- autogenerated from the Grammatical Framework" +++++
+		    "import GF.Formalism.CFG" ++++ 
+                    "import GF.Formalism.Utilities" ++++
+                    "\ngrammar :: CFGrammar String (NameProfile String) String" ++++
+		    "grammar = \n\t[ " ++ 
+		    concat (intersperse "\n\t, " (map prtCRule rules)) ++ "\n\t]\n\n" 
+    where prtCRule (CFRule cat syms (Name fun profiles)) 
+	      = show (CFRule (prt cat) (map (mapSymbol prt id) syms) 
+	                     (Name (prt fun) (map cnvProfile profiles)))
+
+cnvProfile (Unify args) = Unify args
+cnvProfile (Constant forest) = Constant (fmap prt forest)