GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 09:52:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

UTF8 encoding of strings in terms in GFCC in gfc

Browse Source
This commit is contained in:
aarne
2007-10-08 14:20:37 +00:00
parent 91a1d04def
commit 67420e3c9d
4 changed files with 49 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
src/GF/GFCC/DataGFCC.hs
View File

@@ -3,6 +3,8 @@ module GF.GFCC.DataGFCC where
import GF.GFCC.AbsGFCC
import GF.GFCC.PrintGFCC
import GF.Infra.CompactPrint
import GF.Text.UTF8
import Data.Map
import Data.List
@@ -71,7 +73,7 @@ mkGFCC (Grm a cs ab@(Abs afls fs cts) ccs) = GFCC {
-- convert internal GFCC and pretty-print it
printGFCC :: GFCC -> String
printGFCC gfcc = compactPrintGFCC $ printTree $ Grm
printGFCC gfcc0 = compactPrintGFCC $ printTree $ Grm
(absname gfcc)
(cncnames gfcc)
(Abs
@@ -88,9 +90,36 @@ printGFCC gfcc = compactPrintGFCC $ printTree $ Grm
[Lin f v | (f,v) <- assocs (lincats cnc)]
[Lin f v | (f,v) <- assocs (lindefs cnc)]
[Lin f v | (f,v) <- assocs (printnames cnc)]
gfcc = utf8GFCC gfcc0
-- default map and filter are for Map here
lmap = Prelude.map
lfilter = Prelude.filter
mmap = Data.Map.map
-- encode idenfifiers and strings in UTF8
utf8GFCC :: GFCC -> GFCC
utf8GFCC gfcc = gfcc {
concretes = mmap u8concr (concretes gfcc)
}
where
u8concr cnc = cnc {
lins = mmap u8term (lins cnc),
opers = mmap u8term (opers cnc)
}
u8term = convertStringsInTerm encodeUTF8
---- TODO: convert identifiers and flags
convertStringsInTerm conv t = case t of
K (KS s) -> K (KS (conv s))
W s r -> W (conv s) (convs r)
R ts -> R $ lmap convs ts
S ts -> S $ lmap convs ts
FV ts -> FV $ lmap convs ts
P u v -> P (convs u) (convs v)
_ -> t
where
convs = convertStringsInTerm conv

8
src/GF/GFCC/Macros.hs
View File

@@ -24,6 +24,14 @@ lookType :: GFCC -> CId -> Type
lookType gfcc f =
fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
lookAbsFlag :: GFCC -> CId -> String
lookAbsFlag gfcc f =
lookMap (error $ "lookAbsFlag " ++ show f) f (aflags (abstract gfcc))
lookFlag :: GFCC -> CId -> CId -> String
lookFlag gfcc lang fun =
lookMap "?" fun $ flags $ lookMap (error "no lang") lang $ concretes gfcc
functionsToCat :: GFCC -> CId -> [(CId,Type)]
functionsToCat gfcc cat =
[(f,ty) | f <- fs, Just (ty,_) <- [Data.Map.lookup f $ funs $ abstract gfcc]]