blob: a5ecda21467d1d8b3e2e2dfd7c048a14ea32f58f (
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
101
|
----------------------------------------------------------------------
-- |
-- Maintainer : Aarne Ranta
-- Stability : (stable)
-- Portability : (portable)
--
-- mapping from GF-internal FGrammar to bnfc-defined FCFG
-----------------------------------------------------------------------------
module GF.FCFG.ToFCFG (printFGrammar) where
import GF.Formalism.FCFG
import GF.Formalism.SimpleGFC
import GF.Conversion.Types
import GF.Infra.Ident
import qualified GF.FCFG.AbsFCFG as F
import GF.FCFG.PrintFCFG (printTree)
import qualified GF.Canon.AbsGFC as C
import Control.Monad (liftM)
import Data.List (groupBy)
import Data.Array
import GF.Formalism.Utilities
import GF.Formalism.GCFG
import GF.Infra.Print
-- this is the main function used
printFGrammar :: FCFGrammar FCat FName Token -> String
printFGrammar = undefined {- printTree . fgrammar
fgrammar :: FCFGrammar FCat Name Token -> F.FGrammar
fgrammar = F.FGr . map frule
frule :: FCFRule FCat Name Token -> F.FRule
frule (FRule ab rhs) =
F.FR (abstract ab) [[fsymbol sym | (_,sym) <- assocs syms] | (_,syms) <- assocs rhs]
abstract :: Abstract FCat Name -> F.Abstract
abstract (Abs cat cats n) = F.Abs (fcat cat) (map fcat cats) (name n)
fsymbol :: FSymbol FCat Token -> F.FSymbol
fsymbol fs = case fs of
FSymCat fc i j -> F.FSymCat (fcat fc) (toInteger i) (toInteger j)
FSymTok s -> F.FSymTok s
fcat :: FCat -> F.FCat
fcat (FCat i id ps pts) =
F.FC (toInteger i) (ident id) [map pathel p | Path p <- ps]
[F.PtT (map pathel p) (term t) | (Path p,t) <- pts]
name :: Name -> F.Name
name (Name id profs) = F.Nm (ident id) (map profile profs)
pathel :: Either C.Label (Term SCat Token) -> F.PathEl
pathel lt = case lt of
Left lab -> F.PLabel $ label lab
Right trm -> F.PTerm $ term trm
path (Path p) = map pathel p
profile :: Profile (SyntaxForest Fun) -> F.Profile
profile p = case p of
Unify is -> F.Unify (map toInteger is)
Constant sf -> F.Const (forest sf)
forest :: SyntaxForest Fun -> F.Forest
forest f = case f of
FMeta -> F.FMeta
FNode id fss -> F.FNode (ident id) (map (map forest) fss)
FString s -> F.FString s
FInt i -> F.FInt i
FFloat d -> F.FFloat d
term :: Term SCat Token -> F.Term
term tr = case tr of
Arg i id p -> F.Arg (toInteger i) (ident id) (path p)
Rec rs -> F.Rec [F.Ass (label l) (term t) | (l,t) <- rs]
Tbl cs -> F.Tbl [F.Cas (term p) (term v) | (p,v) <- cs]
c :^ ts -> F.Constr (constr c) (map term ts)
t :. l -> F.Proj (term t) (label l)
t :++ u -> F.Concat (term t) (term u)
t :! u -> F.Select (term t) (term u)
Variants ts -> F.Vars $ map term ts
Token s -> F.Tok s
Empty -> F.Empty
label :: C.Label -> F.Label
label b = case b of
C.L x -> F.L $ ident x
C.LV i -> F.LV i
ident :: Ident -> F.Ident
ident = F.Ident . prIdent --- is information lost?
constr (C.CIQ m c) = F.CIQ (ident m) (ident c)
-}
|
