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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
----------------------------------------------------------------------
-- |
-- Maintainer : Krasimir Angelov
-- Stability : (stable)
-- Portability : (portable)
--
-- Definitions of fast multiple context-free grammars
-----------------------------------------------------------------------------
module GF.Formalism.FCFG
(
-- * Token
FToken
-- * Category
, FPath
, FCat(..)
, initialFCat
, fcatString, fcatInt, fcatFloat
, fcat2cid
-- * Symbol
, FIndex
, FSymbol(..)
-- * Name
, FName
, isCoercionF
-- * Grammar
, FPointPos
, FGrammar
, FRule(..)
) where
import Control.Monad (liftM)
import Data.List (groupBy)
import Data.Array
import GF.Formalism.Utilities
import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC
import GF.Infra.PrintClass
------------------------------------------------------------
-- Token
type FToken = String
------------------------------------------------------------
-- Category
type FPath = [FIndex]
data FCat = FCat {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
initialFCat :: AbsGFCC.CId -> FCat
initialFCat cat = FCat 0 cat [] []
fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
fcatInt = FCat (-2) (AbsGFCC.CId "Int") [[0]] []
fcatFloat = FCat (-3) (AbsGFCC.CId "Float") [[0]] []
fcat2cid :: FCat -> AbsGFCC.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
------------------------------------------------------------
-- Symbol
type FIndex = Int
data FSymbol
= FSymCat FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
| FSymTok FToken
------------------------------------------------------------
-- Name
type FName = NameProfile AbsGFCC.CId
isCoercionF :: FName -> Bool
isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.CId "_"
isCoercionF _ = False
------------------------------------------------------------
-- Grammar
type FGrammar = [FRule]
type FPointPos = Int
data FRule = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
------------------------------------------------------------
-- pretty-printing
instance Print AbsGFCC.CId where
prt (AbsGFCC.CId s) = s
instance Print FCat where
prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++
prtSep ";" ([prt path | path <- rcs] ++
[prt path ++ "=" ++ prt term | (path,term) <- tcs])
++ "}"
instance Print FSymbol where
prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
prt (FSymTok t) = simpleShow (prt t)
where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
mkEsc '\\' = "\\\\"
mkEsc '\"' = "\\\""
mkEsc '\n' = "\\n"
mkEsc '\t' = "\\t"
mkEsc chr = [chr]
prtList = prtSep " "
instance Print FRule where
prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
" =\n [" ++ prtSep "\n " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
prtList = prtSep "\n"
|
