move the parsing related stuff to GF.GFCC.Parsing

2 files changed, 0 insertions, 271 deletions

diff --git a/src-3.0/GF/Parsing/FCFG.hs b/src-3.0/GF/Parsing/FCFG.hs
deleted file mode 100644
index 050c30f81..000000000
--- a/src-3.0/GF/Parsing/FCFG.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : Krasimir Angelov
--- Stability   : (stable)
--- Portability : (portable)
---
--- FCFG parsing
------------------------------------------------------------------------------
-
-module GF.Parsing.FCFG
-    (parseFCF,buildParserInfo,ParserInfo(..),makeFinalEdge) where
-
-import GF.Data.SortedList 
-import GF.Data.Assoc
-
-import GF.Infra.PrintClass
-
-import GF.Formalism.Utilities
-
-import GF.Parsing.FCFG.Active
-
-import GF.GFCC.CId
-import GF.GFCC.DataGFCC
-import GF.GFCC.BuildParser
-import GF.GFCC.Macros
-import GF.Data.ErrM
-
-import qualified Data.Map as Map
-
-----------------------------------------------------------------------
--- parsing
-
--- main parsing function
-
-parseFCF :: 
-      String ->         -- ^ parsing strategy
-      ParserInfo ->     -- ^ compiled grammar (fcfg) 
-      CId ->            -- ^ starting category
-      [String] ->       -- ^ input tokens
-      Err [Exp]         -- ^ resulting GF terms
-parseFCF strategy pinfo startCat inString =
-    do let inTokens = input inString
-       startCats <- Map.lookup startCat (startupCats pinfo)
-       fcfParser <- {- trace lctree $ -} parseFCF strategy
-       let chart = fcfParser pinfo startCats inTokens
-	   (i,j) = inputBounds inTokens
-	   finalEdges = [makeFinalEdge cat i j | cat <- startCats]
-	   forests = chart2forests chart (const False) finalEdges
-           filteredForests = forests >>= applyProfileToForest
-	   trees = nubsort $ filteredForests >>= forest2trees
-       return $ map tree2term trees
-    where
-      parseFCF :: String -> Err (FCFParser)
-      parseFCF "bottomup" = Ok  $ parse "b"
-      parseFCF "topdown"  = Ok  $ parse "t"
-      parseFCF strat      = Bad $ "FCFG parsing strategy not defined: " ++ strat
-
-----------------------------------------------------------------------
--- parse trees to GFCC terms
-
-tree2term :: SyntaxTree CId -> Exp
-tree2term (TNode f ts) = tree (AC f) (map tree2term ts)
-
-tree2term (TString  s) = tree (AS s) []
-tree2term (TInt     n) = tree (AI n) []
-tree2term (TFloat   f) = tree (AF f) []
-tree2term (TMeta)      = exp0
-
-----------------------------------------------------------------------
--- conversion and unification of forests
-
--- simplest implementation
-applyProfileToForest :: SyntaxForest (CId,[Profile]) -> [SyntaxForest CId]
-applyProfileToForest (FNode (fun,profiles) children) 
-    | fun == wildCId = concat chForests
-    | otherwise      = [ FNode fun chForests | not (null chForests) ]
-    where chForests  = concat [ mapM (unifyManyForests . map (forests !!)) profiles |
-			        forests0 <- children,
-			        forests <- mapM applyProfileToForest forests0 ]
-applyProfileToForest (FString s) = [FString s]
-applyProfileToForest (FInt    n) = [FInt    n]
-applyProfileToForest (FFloat  f) = [FFloat  f]
-applyProfileToForest (FMeta)     = [FMeta]
diff --git a/src-3.0/GF/Parsing/FCFG/Active.hs b/src-3.0/GF/Parsing/FCFG/Active.hs
deleted file mode 100644
index a64d53f1c..000000000
--- a/src-3.0/GF/Parsing/FCFG/Active.hs
+++ /dev/null
@@ -1,188 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : Krasimir Angelov
--- Stability   : (stable)
--- Portability : (portable)
---
--- MCFG parsing, the active algorithm
------------------------------------------------------------------------------
-
-module GF.Parsing.FCFG.Active (FCFParser, parse, makeFinalEdge) where
-
-import GF.Data.GeneralDeduction
-import GF.Data.Assoc
-import GF.Data.SortedList
-import GF.Data.Utilities
-
-import GF.GFCC.CId
-import GF.GFCC.DataGFCC
-import GF.Formalism.Utilities
-
-import GF.Infra.PrintClass
-
-import Control.Monad (guard)
-
-import qualified Data.List as List
-import qualified Data.Map  as Map
-import qualified Data.Set  as Set
-import Data.Array
-
-----------------------------------------------------------------------
--- * parsing
-
-makeFinalEdge cat 0 0 = (cat, [EmptyRange])
-makeFinalEdge cat i j = (cat, [makeRange i j])
-
--- | the list of categories = possible starting categories
-type FCFParser =  ParserInfo
-               -> [FCat]
-               -> Input FToken
-               -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
-
-
-parse :: String -> FCFParser
-parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
-    where chart = process strategy pinfo toks axioms emptyXChart
-          axioms | isBU  strategy = literals pinfo toks ++ initialBU pinfo toks
-		 | isTD  strategy = literals pinfo toks ++ initialTD pinfo starts toks
-
-isBU  s = s=="b"
-isTD  s = s=="t"
-
--- used in prediction
-emptyChildren :: RuleId -> ParserInfo -> SyntaxNode RuleId RangeRec
-emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
-  where
-    FRule _ _ rhs _ _ = allRules pinfo ! ruleid
-
-process :: String -> ParserInfo -> Input FToken -> [(FCat,Item)] -> XChart FCat -> XChart FCat
-process strategy pinfo toks []               chart = chart
-process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
-  where
-    univRule cat item@(Active found rng lbl ppos node@(SNode ruleid recs)) chart
-      | inRange (bounds lin) ppos =
-           case lin ! ppos of
-             FSymCat r d -> let c = args !! d
-                            in case recs !! d of
-                                [] -> case insertXChart chart item c of
-	                                Nothing    -> chart
-	                                Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c
-	                			                     rng  <- concatRange rng (found' !! r)
-	     			                                     return (c, Active found rng lbl (ppos+1) (SNode ruleid (updateNth (const found') d recs)))
-	     			                                  ++
-	     			                                  do guard (isTD strategy)
-	     			                                     ruleid <- topdownRules pinfo ? c
-	     			                                     return (c, Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))
-	     			                      in process strategy pinfo toks items chart
-	     			found' -> let items = do rng  <- concatRange rng (found' !! r)
-	     			                         return (c, Active found rng lbl (ppos+1) node)
-	     			          in process strategy pinfo toks items chart
-	     FSymTok tok -> let items = do t_rng <- inputToken toks ? tok
-	                                   rng' <- concatRange rng t_rng
-	                                   return (cat, Active found rng' lbl (ppos+1) node)
-                            in process strategy pinfo toks items chart
-      | otherwise =
-           if inRange (bounds lins) (lbl+1)
-             then univRule cat (Active          (rng:found)  EmptyRange (lbl+1) 0 node) chart
-             else univRule cat (Final  (reverse (rng:found))                      node) chart
-      where
-        (FRule _ _ args cat lins) = allRules pinfo ! ruleid
-        lin                       = lins ! lbl
-    univRule cat item@(Final found' node) chart =
-      case insertXChart chart item cat of
-        Nothing    -> chart
-        Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
-                                     let FRule _ _ args _ lins = allRules pinfo ! ruleid
-                                         FSymCat r d = lins ! l ! ppos
-                                     rng  <- concatRange rng (found' !! r)
-                                     return (args !! d, Active found rng l (ppos+1) (updateChildren node d found'))
-                                  ++
-    			          do guard (isBU strategy)
-			             ruleid <- leftcornerCats pinfo ? cat
-			             let FRule _ _ args _ lins = allRules pinfo ! ruleid
-			                 FSymCat r d  = lins ! 0 ! 0
-                                     return (args !! d, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found'))
-
-                          updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> SyntaxNode RuleId RangeRec
-                          updateChildren (SNode ruleid recs) i rec = SNode ruleid $! updateNth (const rec) i recs
-                      in process strategy pinfo toks items chart
-
-----------------------------------------------------------------------
--- * XChart
-
-data Item
-  = Active RangeRec
-           Range
-           {-# UNPACK #-} !FIndex
-           {-# UNPACK #-} !FPointPos
-           (SyntaxNode RuleId RangeRec)
-  | Final RangeRec (SyntaxNode RuleId RangeRec)
-  deriving (Eq, Ord)
-
-data XChart c = XChart !(ParseChart Item c) !(ParseChart Item c)
-
-emptyXChart :: Ord c => XChart c
-emptyXChart = XChart emptyChart emptyChart
-
-insertXChart (XChart actives finals) item@(Active _ _ _ _ _) c = 
-  case chartInsert actives item c of
-    Nothing      -> Nothing
-    Just actives -> Just (XChart actives finals)
-
-insertXChart (XChart actives finals) item@(Final _ _) c =
-  case chartInsert finals item c of
-    Nothing     -> Nothing
-    Just finals -> Just (XChart actives finals)
-
-lookupXChartAct   (XChart actives finals) c = chartLookup actives c
-lookupXChartFinal (XChart actives finals) c = chartLookup finals  c
-
-xchart2syntaxchart :: XChart FCat -> ParserInfo -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
-xchart2syntaxchart (XChart actives finals) pinfo =
-  accumAssoc groupSyntaxNodes $
-    [ case node of
-        SNode ruleid rrecs -> let FRule fun prof rhs cat _ = allRules pinfo ! ruleid
-		              in ((cat,found), SNode (fun,prof) (zip rhs rrecs))
-        SString s          ->    ((cat,found), SString s)
-        SInt    n          ->    ((cat,found), SInt    n)
-        SFloat  f          ->    ((cat,found), SFloat  f)
-    | (cat, Final found node) <- chartAssocs finals
-    ]
-
-literals :: ParserInfo -> Input FToken -> [(FCat,Item)]
-literals pinfo toks =
-  [let (c,node) = lexer t in (c,Final [rng] node) | (t,rngs) <- aAssocs (inputToken toks), rng <- rngs, not (t `elem` grammarToks pinfo)]
-  where
-    lexer t =
-      case reads t of
-        [(n,"")] -> (fcatInt, SInt (n::Integer))
-        _        -> case reads t of
-                      [(f,"")] -> (fcatFloat, SFloat  (f::Double))
-                      _        -> (fcatString,SString t)
-
-
-----------------------------------------------------------------------
--- Earley --
-
--- called with all starting categories
-initialTD :: ParserInfo -> [FCat] -> Input FToken -> [(FCat,Item)]
-initialTD pinfo starts toks = 
-    do cat <- starts
-       ruleid <- topdownRules pinfo ? cat
-       return (cat,Active [] (Range 0 0) 0 0 (emptyChildren ruleid pinfo))
-
-
-----------------------------------------------------------------------
--- Kilbury --
-
-initialBU :: ParserInfo -> Input FToken -> [(FCat,Item)]
-initialBU pinfo toks =
-    do (tok,rngs) <- aAssocs (inputToken toks)
-       ruleid <- leftcornerTokens pinfo ? tok
-       let FRule _ _ _ cat _ = allRules pinfo ! ruleid
-       rng <- rngs
-       return (cat,Active [] rng 0 1 (emptyChildren ruleid pinfo))
-    ++
-    do ruleid <- epsilonRules pinfo
-       let FRule _ _ _ cat _ = allRules pinfo ! ruleid
-       return (cat,Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))