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
|
module GF.GFCC.ShowLinearize (
tableLinearize,
recordLinearize,
termLinearize
) where
import GF.GFCC.Linearize
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.PrintGFCC ----
import GF.Data.Operations
import Data.List
-- printing linearizations with parameters
data Record =
RR [(String,Record)]
| RT [(String,Record)]
| RFV [Record]
| RS String
| RCon String
prRecord :: Record -> String
prRecord = prr where
prr t = case t of
RR fs -> concat $
"{" :
(intersperse ";" (map (\ (l,v) -> unwords [l,"=", prr v]) fs)) ++ ["}"]
RT fs -> concat $
"table {" :
(intersperse ";" (map (\ (l,v) -> unwords [l,"=>",prr v]) fs)) ++ ["}"]
RFV ts -> concat $
"variants {" : (intersperse ";" (map prr ts)) ++ ["}"]
RS s -> prQuotedString s
RCon s -> s
mkRecord :: Term -> Term -> Record
mkRecord typ trm = case (typ,trm) of
(R rs, R ts) -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts]
(S [FV ps,ty],R ts) -> RT [(str par, mkRecord ty t) | (par, t) <- zip ps ts]
(_,W s (R ts)) -> mkRecord typ (R [K (KS (s ++ u)) | K (KS u) <- ts])
(FV ps, C i) -> RCon $ str $ ps !! i
(S [], _) -> RS $ realize trm
_ -> RS $ printTree trm
where
str = realize
tableLinearize :: GFCC -> CId -> Exp -> String
tableLinearize gfcc lang = unlines . branches . recLinearize gfcc lang where
branches r = case r of
RR fs -> [lab +++ b | (lab,t) <- fs, b <- branches t]
RT fs -> [lab +++ b | (lab,t) <- fs, b <- branches t]
RFV rs -> intersperse "|" (concatMap branches rs)
RS s -> [" : " ++ s]
RCon _ -> []
recordLinearize :: GFCC -> CId -> Exp -> String
recordLinearize gfcc lang = prRecord . recLinearize gfcc lang
termLinearize :: GFCC -> CId -> Exp -> String
termLinearize gfcc lang = printTree . linExp gfcc lang
recLinearize :: GFCC -> CId -> Exp -> Record
recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where
typ = case exp of
DTr _ (AC f) _ -> lookParamLincat gfcc lang $ valCat $ lookType gfcc f
|
