blob: 2be442a299d0e475cc6c656995520af02fcc2e83 (
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
|
----------------------------------------------------------------------
-- |
-- Maintainer : Krasimir Angelov
-- Stability : (stable)
-- Portability : (portable)
--
-- Definitions of fast multiple context-free grammars
-----------------------------------------------------------------------------
module GF.Formalism.FCFG where
import Control.Monad (liftM)
import Data.List (groupBy)
import Data.Array
import GF.Formalism.Utilities
import GF.Formalism.GCFG
import GF.Infra.Print
------------------------------------------------------------
-- grammar types
type FLabel = Int
type FPointPos = Int
data FSymbol cat tok
= FSymCat cat {-# UNPACK #-} !FLabel {-# UNPACK #-} !Int
| FSymTok tok
type FCFGrammar cat name tok = [FCFRule cat name tok]
data FCFRule cat name tok = FRule name [cat] cat (Array FLabel (Array FPointPos (FSymbol cat tok)))
------------------------------------------------------------
-- pretty-printing
instance (Print c, Print t) => Print (FSymbol c t) 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 c, Print n, Print t) => Print (FCFRule n c t) 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"
|
