GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-10 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

move GF.Formalism.FCFG types to GF.GFCC.DataGFCC

Browse Source
This commit is contained in:
krasimir
2008-05-29 12:08:45 +00:00
parent 363ddd7b91
commit 9a759a66dc
11 changed files with 176 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src-3.0/GF/GFCC/Linearize.hs
View File

@@ -4,7 +4,7 @@ import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.CId
import GF.Infra.PrintClass
import Data.Map
import qualified Data.Map as Map
import Data.List
import Debug.Trace
@@ -17,7 +17,7 @@ linearize mcfg lang = realize . linExp mcfg lang
realize :: Term -> String
realize trm = case trm of
R ts -> realize (ts !! 0)
S ss -> unwords $ lmap realize ss
S ss -> unwords $ map realize ss
K t -> case t of
KS s -> s
KP s _ -> unwords s ---- prefix choice TODO
@@ -29,13 +29,13 @@ realize trm = case trm of
linExp :: GFCC -> CId -> Exp -> Term
linExp mcfg lang tree@(DTr xs at trees) =
addB $ case at of
AC fun -> comp (lmap lin trees) $ look fun
AC fun -> comp (map lin trees) $ look fun
AS s -> R [kks (show s)] -- quoted
AI i -> R [kks (show i)]
--- [C lst, kks (show i), C size] where
--- lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1
AF d -> R [kks (show d)]
AV x -> TM (prt x)
AV x -> TM (prCId x)
AM i -> TM (show i)
where
lin = linExp mcfg lang
@@ -44,31 +44,31 @@ linExp mcfg lang tree@(DTr xs at trees) =
addB t
| Data.List.null xs = t
| otherwise = case t of
R ts -> R $ ts ++ (Data.List.map (kks . prt) xs)
TM s -> R $ t : (Data.List.map (kks . prt) xs)
R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
TM s -> R $ t : (Data.List.map (kks . prCId) xs)
compute :: GFCC -> CId -> [Term] -> Term -> Term
compute mcfg lang args = comp where
comp trm = case trm of
P r p -> proj (comp r) (comp p)
W s t -> W s (comp t)
R ts -> R $ lmap comp ts
R ts -> R $ map comp ts
V i -> idx args i -- already computed
F c -> comp $ look c -- not computed (if contains argvar)
FV ts -> FV $ lmap comp ts
S ts -> S $ lfilter (/= S []) $ lmap comp ts
FV ts -> FV $ map comp ts
S ts -> S $ filter (/= S []) $ map comp ts
_ -> trm
look = lookOper mcfg lang
idx xs i = if i > length xs - 1
then trace
("too large " ++ show i ++ " for\n" ++ unlines (lmap show xs) ++ "\n") tm0
("too large " ++ show i ++ " for\n" ++ unlines (map show xs) ++ "\n") tm0
else xs !! i
proj r p = case (r,p) of
(_, FV ts) -> FV $ lmap (proj r) ts
(FV ts, _ ) -> FV $ lmap (\t -> proj t p) ts
(_, FV ts) -> FV $ map (proj r) ts
(FV ts, _ ) -> FV $ map (\t -> proj t p) ts
(W s t, _) -> kks (s ++ getString (proj t p))
_ -> comp $ getField r (getIndex p)