1 files changed, 114 insertions, 0 deletions
diff --git a/src-3.0/GF/Embed/EmbedAPI.hs b/src-3.0/GF/Embed/EmbedAPI.hs
new file mode 100644
index 000000000..43e4f2546
--- /dev/null
+++ b/src-3.0/GF/Embed/EmbedAPI.hs
@@ -0,0 +1,114 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EmbedAPI
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- Reduced Application Programmer's Interface to GF, meant for
+-- embedded GF systems. AR 10/5/2005
+-----------------------------------------------------------------------------
+
+module GF.Embed.EmbedAPI where
+
+import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar,firstStateGrammar,allLanguages,allCategories,stateOptions,firstAbsCat)
+import GF.UseGrammar.Linear (linTree2string)
+import GF.UseGrammar.GetTree (string2tree)
+import GF.Embed.EmbedParsing (parseString)
+import GF.Canon.CMacros (noMark)
+import GF.Grammar.Grammar (Trm)
+import GF.Grammar.MMacros (exp2tree)
+import GF.Grammar.Macros (zIdent)
+import GF.Grammar.PrGrammar (prt_)
+import GF.Grammar.Values (tree2exp)
+import GF.Grammar.TypeCheck (annotate)
+import GF.Canon.GetGFC (getCanonGrammar)
+import GF.Infra.Modules (emptyMGrammar)
+import GF.CF.CFIdent (string2CFCat)
+import GF.Infra.UseIO
+import GF.Data.Operations
+import GF.Infra.Option (noOptions,useUntokenizer,options,iOpt)
+import GF.Infra.Ident (prIdent)
+import GF.Embed.EmbedCustom
+
+-- This API is meant to be used when embedding GF grammars in Haskell 
+-- programs. The embedded system is supposed to use the
+-- .gfcm grammar format, which is first produced by the gf program.
+
+---------------------------------------------------
+-- Interface
+---------------------------------------------------
+
+type MultiGrammar = ShellState
+type Language     = String
+type Category     = String
+type Tree         = Trm
+
+file2grammar :: FilePath -> IO MultiGrammar
+
+linearize    :: MultiGrammar -> Language -> Tree -> String
+parse        :: MultiGrammar -> Language -> Category -> String -> [Tree]
+
+linearizeAll     :: MultiGrammar -> Tree -> [String]
+linearizeAllLang :: MultiGrammar -> Tree -> [(Language,String)]
+
+parseAll     :: MultiGrammar -> Category -> String -> [[Tree]]
+parseAllLang :: MultiGrammar -> Category -> String -> [(Language,[Tree])]
+
+readTree     :: MultiGrammar -> String -> Tree
+showTree     ::                 Tree -> String
+
+languages    :: MultiGrammar -> [Language]
+categories   :: MultiGrammar -> [Category]
+
+startCat :: MultiGrammar -> Category
+
+---------------------------------------------------
+-- Implementation
+---------------------------------------------------
+
+file2grammar file = do
+  can <- useIOE (error "cannot parse grammar file") $ getCanonGrammar file
+  return $ errVal (error "cannot build multigrammar") $ 
+    grammar2shellState (options [iOpt "docf"]) (can,emptyMGrammar) 
+
+linearize mgr lang = 
+  untok .
+  linTree2string noMark (canModules mgr) (zIdent lang) . 
+  errVal (error "illegal tree") . 
+  annotate gr
+ where
+   gr    = grammar sgr
+   sgr   = stateGrammarOfLang mgr (zIdent lang)
+   untok = customOrDefault (stateOptions sgr) useUntokenizer customUntokenizer sgr
+
+parse mgr lang cat = 
+  map tree2exp . 
+  errVal [] . 
+  parseString (stateOptions sgr) sgr cfcat
+ where
+   sgr   = stateGrammarOfLang mgr (zIdent lang)
+   cfcat = string2CFCat abs cat
+   abs   = maybe (error "no abstract syntax") prIdent $ abstract mgr
+
+linearizeAll mgr = map snd . linearizeAllLang mgr
+linearizeAllLang mgr t = [(lang,linearize mgr lang t) | lang <- languages mgr]
+
+parseAll mgr cat = map snd . parseAllLang mgr cat
+
+parseAllLang mgr cat s = 
+  [(lang,ts) | lang <- languages mgr, let ts = parse mgr lang cat s, not (null ts)]
+
+readTree mgr s = tree2exp $ string2tree (firstStateGrammar mgr) s
+
+showTree t  = prt_ t
+
+languages mgr = [prt_ l | l <- allLanguages mgr]
+
+categories mgr = [prt_ c | (_,c) <- allCategories mgr]
+
+startCat = prt_ . snd . firstAbsCat noOptions . firstStateGrammar