refactored FCFG parsing to fit in GFCC shell

2 files changed, 31 insertions, 48 deletions

diff --git a/src/GF/Canon/GFCC/FCFGParsing.hs b/src/GF/Canon/GFCC/FCFGParsing.hs
index f9a838417..e5258764c 100644
--- a/src/GF/Canon/GFCC/FCFGParsing.hs
+++ b/src/GF/Canon/GFCC/FCFGParsing.hs
@@ -1,8 +1,8 @@
-module GF.Canon.GFCC.FCFGParsing where
+module GF.Canon.GFCC.FCFGParsing (parserLang) where
 
 import GF.Canon.GFCC.DataGFCC
 import GF.Canon.GFCC.AbsGFCC
-import GF.Conversion.SimpleToFCFG (convertGrammar)
+import GF.Conversion.SimpleToFCFG (convertGrammarCId,FCat(..))
 
 --import GF.System.Tracing 
 --import GF.Infra.Print
@@ -20,8 +20,9 @@ import GF.Conversion.SimpleToFCFG (convertGrammar)
 import GF.Data.SortedList 
 import GF.Data.Assoc
 import GF.Formalism.Utilities --(forest2trees)
+import qualified GF.Data.Operations as Op
 
---import GF.Conversion.Types
+import GF.Conversion.FTypes
 
 import GF.Formalism.FCFG
 --import qualified GF.Formalism.GCFG as G
@@ -32,16 +33,15 @@ import GF.Formalism.FCFG
 import qualified GF.Parsing.FCFG as PF
 --import qualified GF.Parsing.CFG as PC
 import GF.Canon.GFCC.ErrM
+import GF.Infra.PrintClass
 
+--convertGrammarCId :: Grammar -> [(CId,FGrammar)]
 
---convertGrammar :: Grammar -> [(Ident,FGrammar)]
+parserLang :: GFCC -> CId -> CFCat -> [CFTok] -> Err [Exp]
+parserLang mgr lang = parse info where
+  fcfgs = convertGrammarCId mgr
+  info  = buildPInfo $ maybe (error "no parser") id $ lookup lang fcfgs
 
---import qualified GF.Parsing.GFC as New
---checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
--- algorithm "f"
--- strategy "bottomup"
-
-type Token = String ----
 type CFTok = String ----
 type CFCat = CId ----
 type Fun = CId ----
@@ -54,6 +54,16 @@ wordsCFTok = return ----
 
 type FCFPInfo = PF.FCFPInfo FCat FName Token
 
+buildPInfo :: FGrammar -> FCFPInfo
+buildPInfo fcfg = PF.buildFCFPInfo grammarLexer fcfg where
+  grammarLexer s =
+      case reads s of
+        [(n,"")] -> (fcatInt, SInt (n::Integer))
+        _        -> case reads s of
+                      [(f,"")] -> (fcatFloat, SFloat  (f::Double))
+                      _        -> (fcatString,SString s)
+
+
 -- main parsing function
 
 parse :: 
@@ -65,7 +75,7 @@ parse ::
       [CFTok] ->        -- ^ input tokens
       Err [Exp]         -- ^ resulting GF terms
 
-parse pinfo startCat inString = 
+parse pinfo startCat inString = e2e $
 
     do let inTokens = inputMany (map wordsCFTok inString)
        forests <- selectParser pinfo startCat inTokens
@@ -107,7 +117,7 @@ cnv_forests2 (FFloat  x)   = FFloat  x
 -- parse trees to GFCC terms
 
 tree2term :: SyntaxTree Fun -> Exp
-tree2term (TNode f ts) = Tr (AC (CId f)) (map tree2term ts)
+tree2term (TNode f ts) = Tr (AC f) (map tree2term ts)
 {- ----
 tree2term (TString  s) = Macros.string2term s
 tree2term (TInt     n) = Macros.int2term    n
@@ -122,7 +132,7 @@ tree2term (TMeta)      = Macros.mkMeta 0
 -- simplest implementation
 applyProfileToForest :: SyntaxForest Name -> [SyntaxForest Fun]
 applyProfileToForest (FNode name@(Name fun profile) children) 
-    | isCoercion name = concat chForests
+    | isCoercionF name = concat chForests
     | otherwise       = [ FNode fun chForests | not (null chForests) ]
     where chForests   = concat [ applyProfileM unifyManyForests profile forests |
 				 forests0 <- children,
@@ -132,40 +142,10 @@ applyProfileToForest (FInt    n) = [FInt    n]
 applyProfileToForest (FFloat  f) = [FFloat  f]
 applyProfileToForest (FMeta)     = [FMeta]
 
-
---------------------- From parsing types ------------------------------
-
--- * fast nonerasing MCFG
-
-type FIndex   = Int
-type FPath    = [FIndex]
-type FName    = NameProfile CId
-type FGrammar = FCFGrammar FCat FName Token
-type FRule    = FCFRule    FCat FName Token
-data FCat     = FCat  {-# UNPACK #-} !Int CId [FPath] [(FPath,FIndex)]
-
-initialFCat :: CId -> FCat
-initialFCat cat = FCat 0 cat [] []
-
-fcatString = FCat (-1) (CId "String") [[0]] []
-fcatInt    = FCat (-2) (CId "Int")    [[0]] []
-fcatFloat  = FCat (-3) (CId "Float")  [[0]] []
-
-fcat2cid :: FCat -> CId
-fcat2cid (FCat _ c _ _) = c
-
-instance Eq FCat where
-  (FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
-
-instance Ord FCat where
-  compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
-
-
-
 ---
 
-isCoercion :: Name -> Bool
-isCoercion (Name fun [Unify [0]]) = False -- isWildIdent fun
-isCoercion _ = False
+e2e :: Op.Err a -> Err a
+e2e e = case e of
+  Op.Ok v -> Ok v
+  Op.Bad s -> Bad s
 
-type Name = NameProfile Fun
diff --git a/src/GF/Canon/GFCC/GFCCAPI.hs b/src/GF/Canon/GFCC/GFCCAPI.hs
index e815697d7..5630f97ea 100644
--- a/src/GF/Canon/GFCC/GFCCAPI.hs
+++ b/src/GF/Canon/GFCC/GFCCAPI.hs
@@ -21,6 +21,7 @@ import GF.Canon.GFCC.AbsGFCC
 import GF.Canon.GFCC.ParGFCC
 import GF.Canon.GFCC.PrintGFCC
 import GF.Canon.GFCC.ErrM
+import GF.Canon.GFCC.FCFGParsing
 --import GF.Data.Operations
 --import GF.Infra.UseIO
 import qualified Data.Map as Map
@@ -70,7 +71,9 @@ file2grammar f =
 linearize mgr lang = GF.Canon.GFCC.DataGFCC.linearize mgr (CId lang)
 
 
-parse mgr lang cat s = [] 
+parse mgr lang cat s = 
+  err error id $ parserLang mgr (CId lang) (CId cat) (words s)
+
 {-
   map tree2exp . 
   errVal [] .