blob: 30a7801c82c6548acb92e3ae03c810d19a348679 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
----------------------------------------------------------------------
-- |
-- Maintainer : Krasimir Angelov
-- Stability : (stable)
-- Portability : (portable)
--
-- FCFG parsing
-----------------------------------------------------------------------------
module GF.Parsing.FCFG
(parseFCF,buildFCFPInfo,FCFPInfo(..),makeFinalEdge) where
import GF.Data.SortedList
import GF.Data.Assoc
import GF.Infra.PrintClass
import GF.Formalism.FCFG
import GF.Formalism.Utilities
import qualified GF.Parsing.FCFG.Active as Active
import GF.Parsing.FCFG.PInfo
import GF.GFCC.DataGFCC
import GF.GFCC.CId
import GF.GFCC.Macros
import GF.Data.ErrM
import qualified Data.Map as Map
----------------------------------------------------------------------
-- parsing
-- main parsing function
parseFCF ::
String -> -- ^ parsing strategy
FCFPInfo -> -- ^ 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 = map cnv_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 $ Active.parse "b"
parseFCF "topdown" = Ok $ Active.parse "t"
parseFCF strat = Bad $ "FCFG parsing strategy not defined: " ++ strat
cnv_forests FMeta = FMeta
cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (CId n) (map cnv_profile p)) (map (map cnv_forests) fss)
cnv_forests (FString x) = FString x
cnv_forests (FInt x) = FInt x
cnv_forests (FFloat x) = FFloat x
cnv_profile (Unify x) = Unify x
cnv_profile (Constant x) = Constant (cnv_forests2 x)
cnv_forests2 FMeta = FMeta
cnv_forests2 (FNode (CId n) fss) = FNode (CId n) (map (map cnv_forests2) fss)
cnv_forests2 (FString x) = FString x
cnv_forests2 (FInt x) = FInt x
cnv_forests2 (FFloat x) = FFloat x
----------------------------------------------------------------------
-- 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 FName -> [SyntaxForest CId]
applyProfileToForest (FNode name@(Name fun profile) children)
| isCoercionF name = concat chForests
| otherwise = [ FNode fun chForests | not (null chForests) ]
where chForests = concat [ applyProfileM unifyManyForests profile forests |
forests0 <- children,
forests <- mapM applyProfileToForest forests0 ]
applyProfileToForest (FString s) = [FString s]
applyProfileToForest (FInt n) = [FInt n]
applyProfileToForest (FFloat f) = [FFloat f]
applyProfileToForest (FMeta) = [FMeta]
|
