summaryrefslogtreecommitdiff
path: root/src/GF/Parsing/MCFG/Incremental2.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Parsing/MCFG/Incremental2.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Parsing/MCFG/Incremental2.hs')
-rw-r--r--src/GF/Parsing/MCFG/Incremental2.hs157
1 files changed, 0 insertions, 157 deletions
diff --git a/src/GF/Parsing/MCFG/Incremental2.hs b/src/GF/Parsing/MCFG/Incremental2.hs
deleted file mode 100644
index db6c3084e..000000000
--- a/src/GF/Parsing/MCFG/Incremental2.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer : PL
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/08 09:01:25 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
---
--- MCFG parsing, the incremental algorithm (alternative version)
------------------------------------------------------------------------------
-
-module GF.Parsing.MCFG.Incremental2 (parse) where
-
-import Data.List
-import Data.Array
-import Control.Monad (guard)
-
-import GF.Data.Utilities (select)
-import GF.Data.Assoc
-import GF.Data.IncrementalDeduction
-
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Formalism.Utilities
-
-import GF.Parsing.MCFG.Range
-import GF.Parsing.MCFG.PInfo
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-----------------------------------------------------------------------
--- parsing
-
--- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
-parse pinfo starts inp =
- accumAssoc groupSyntaxNodes $
- [ ((cat, found), SNode fun (zip rhs rrecs)) |
- k <- uncurry enumFromTo (inputBounds inp),
- Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
- where chart = process pinfo inp
-
---process :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> (Int, Int) -> IChart c n l
-process pinfo inp
- = tracePrt "MCFG.Incremental - chart size"
- (prt . map (prtSizes finalChart . fst) . assocs) $
- finalChart
- where finalChart = buildChart keyof rules axioms inBounds
- axioms k = tracePrt ("MCFG.Incremental - axioms for " ++ show k) (prt . length) $
- predict k ++ scan k ++ complete1 k
- rules k item = complete2 k item ++ combine k item ++ convert k item
- inBounds = inputBounds inp
-
- -- axioms: predict + scan + complete
- predict k = do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo inp
- let daughters = replicate (length rhs) []
- (lin, lins') <- select lins
- return $ Active abs [] k lin lins' daughters
-
- scan k = do (tok, js) <- aAssocs (inputTo inp ! k)
- j <- js
- Active abs found i (Lin l (Tok _tok:syms)) lins recs <-
- chartLookup finalChart j (ActTok tok)
- return $ Active abs found i (Lin l syms) lins recs
-
- complete1 k = do j <- [fst inBounds .. k-1]
- Active abs found i (Lin l _Nil) lins recs <-
- chartLookup finalChart j Pass
- let found' = found ++ [(l, makeRange (i,j))]
- (lin, lins') <- select lins
- return $ Active abs found' k lin lins' recs
-
- -- rules: convert + combine + complete
- convert k (Active rule found j (Lin lbl []) [] recs) =
- let found' = found ++ [(lbl, makeRange (j,k))]
- in return $ Final rule found' recs
- convert _ _ = []
-
- combine k (Active (Abs cat _ _) found' j (Lin lbl []) _ _) =
- do guard (j < k) ---- cannot handle epsilon-rules
- Active abs found i (Lin l (Cat (_cat,_lbl,nr):syms)) lins recs <-
- chartLookup finalChart j (Act cat lbl)
- let found'' = found' ++ [(lbl, makeRange (j,k))]
- recs' <- unifyRec recs nr found''
- return $ Active abs found i (Lin l syms) lins recs'
- combine _ _ = []
-
- complete2 k (Active abs found i (Lin l []) lins recs) =
- do let found' = found ++ [(l, makeRange (i,k))]
- (lin, lins') <- select lins
- return $ Active abs found' k lin lins' recs
- complete2 _ _ = []
-
-----------------------------------------------------------------------
--- type definitions
-
-type IChart c n l t = IncrementalChart (Item c n l t) (IKey c l t)
-
-data Item c n l t = Active (Abstract c n)
- (RangeRec l)
- Int
- (Lin c l t)
- (LinRec c l t)
- [RangeRec l]
- | Final (Abstract c n) (RangeRec l) [RangeRec l]
- ---- | Passive c (RangeRec l)
- deriving (Eq, Ord, Show)
-
-data IKey c l t = Act c l
- | ActTok t
- ---- | Useless
- | Pass
- | Fin
- deriving (Eq, Ord, Show)
-
-keyof :: Item c n l t -> IKey c l t
-keyof (Active _ _ _ (Lin _ (Cat (next,lbl,_):_)) _ _) = Act next lbl
-keyof (Active _ _ _ (Lin _ (Tok tok:_)) _ _) = ActTok tok
-keyof (Active _ _ _ (Lin _ []) _ _) = Pass
-keyof (Final _ _ _) = Fin
--- keyof _ = Useless
-
-
-----------------------------------------------------------------------
--- for tracing purposes
-prtSizes chart k = "f=" ++ show (length (chartLookup chart k Fin)) ++
- " p=" ++ show (length (chartLookup chart k Pass)) ++
- " a=" ++ show (sum [length (chartLookup chart k key) |
- key@(Act _ _) <- chartKeys chart k ]) ++
- " t=" ++ show (sum [length (chartLookup chart k key) |
- key@(ActTok _) <- chartKeys chart k ])
- -- " u=" ++ show (length (chartLookup chart k Useless))
-
--- prtChart chart = concat [ "\n*** KEY: " ++ prt k ++
--- prtBefore "\n " (chartLookup chart k) |
--- k <- chartKeys chart ]
-
-instance (Print c, Print n, Print l, Print t) => Print (Item c n l t) where
- prt (Active abs found rng lin tofind children) =
- "? " ++ prt abs ++ ";\n\t" ++
- "{" ++ prtSep " " found ++ "} " ++ prt rng ++ " . " ++
- prt lin ++ "{" ++ prtSep " " tofind ++ "}" ++
- ( if null children then ";" else ";\n\t" ++
- "{" ++ prtSep "} {" (map (prtSep " ") children) ++ "}" )
- -- prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
- prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++
- ( if null rrs then ";" else ";\n\t" ++
- "{" ++ prtSep "} {" (map (prtSep " ") rrs) ++ "}" )
-
-instance (Print c, Print l, Print t) => Print (IKey c l t) where
- prt (Act c l) = "Active " ++ prt c ++ " " ++ prt l
- prt (ActTok t) = "ActiveTok " ++ prt t
- -- prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
- prt (Fin) = "Final"
- -- prt (Useless) = "Useless"