msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

more cases in Old2New

Browse Source
This commit is contained in:
aarne
2014-02-26 09:09:21 +00:00
parent 7e0292f6e0
commit e0a9e01e96
1 changed files with 30 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
lib/src/experimental/transfer/Old2New.hs
View File

@@ -5,15 +5,20 @@ import Both
onUtt :: Tree a -> Tree a ----GUtt_ -> Tree GUtt_ onUtt :: Tree a -> Tree a ----GUtt_ -> Tree GUtt_
onUtt t = case t of onUtt t = case t of
GUttS s -> GUttPrS (onS s) GUttAP ap -> GUttAP (onAP ap)
GUttQS qs -> GUttPrS (GUseQCl_none (onQS2QCl qs)) GUttAdv adv -> GUttAdv (onAdv adv)
GUttCN cn -> GUttCN (onCN cn)
GUttNP np -> GUttNP (onNP np)
GUttImpPl pol (GImpVP vp) -> GPrImpPl (onVP GTPres GASimul pol vp) GUttImpPl pol (GImpVP vp) -> GPrImpPl (onVP GTPres GASimul pol vp)
GUttImpPol pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp) ---- GUttImpPol pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp) ----
GUttImpSg pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp) GUttImpSg pol (GImpVP vp) -> GPrImpSg (onVP GTPres GASimul pol vp)
GUttNP np -> GUttNP (onNP np) GUttQS qs -> GUttPrS (GUseQCl_none (onQS2QCl qs))
GUttCN cn -> GUttCN (onCN cn) GUttS s -> GUttPrS (onS s)
---- GUttVP s -> GUttPrVPI (GInfVP_none (onVP GTPres ant pol vp)) ----+
_ -> t ---- composOp onUtt t
_ -> composOp onUtt t
onS :: Tree GS_ -> Tree GPrS_ onS :: Tree GS_ -> Tree GPrS_
onS s = case s of onS s = case s of
@@ -60,10 +65,10 @@ onVP t a p vp = case vp of
GComplVV vv ant pol vp -> GComplVV_none (GUseV_v a t p (GLiftVV vv)) (GInfVP_none (onVP GTPres ant pol vp)) -- !! GComplVV vv ant pol vp -> GComplVV_none (GUseV_v a t p (GLiftVV vv)) (GInfVP_none (onVP GTPres ant pol vp)) -- !!
GComplSlash vps np -> GComplV2_none (onVPSlash t a p vps) np GComplSlash vps np -> GComplV2_none (onVPSlash t a p vps) np
GUseComp comp -> case comp of GUseComp comp -> case comp of
GCompAP ap -> GUseAP_none a t p (GLiftAP ap) GCompAP ap -> GUseAP_none a t p (GLiftAP (onAP ap))
GCompAdv adv -> GUseAdv_none a t p (GLiftAdv adv) GCompAdv adv -> GUseAdv_none a t p (GLiftAdv (onAdv adv))
GCompCN cn -> GUseCN_none a t p (GLiftCN cn) GCompCN cn -> GUseCN_none a t p (GLiftCN (onCN cn))
GCompNP np -> GUseNP_none a t p np GCompNP np -> GUseNP_none a t p (onNP np)
GCompS s -> GUseS_none a t p (onS2Cl s) GCompS s -> GUseS_none a t p (onS2Cl s)
GCompQS qs -> GUseQ_none a t p (onQS2QCl qs) GCompQS qs -> GUseQ_none a t p (onQS2QCl qs)
GCompVP ant pol vp -> GUseVP_none a t p (GInfVP_none (onVP GTPres ant pol vp)) -- !! GCompVP ant pol vp -> GUseVP_none a t p (GInfVP_none (onVP GTPres ant pol vp)) -- !!
@@ -118,6 +123,22 @@ onCN cn = case cn of
GRelCN cn rs -> GRelCN (onCN cn) (onRS rs) GRelCN cn rs -> GRelCN (onCN cn) (onRS rs)
_ -> cn ----composOp onCN cn _ -> cn ----composOp onCN cn
onAdv :: Tree GAdv_ -> Tree GAdv_
onAdv adv = case adv of
GAdAdv ada adv -> GAdAdv ada (onAdv adv)
GComparAdvAdj cadv a np -> GComparAdvAdj cadv a (onNP np)
---- GComparAdvAdjS cadv a s -> GComparAdvAdjS cadv a (onS s)
GPrepNP prep np -> GPrepNP prep (onNP np)
GSubjS subj s -> error "GSubjS"
GConjAdv conj (GListAdv advs) -> GConjAdv conj (GListAdv (map onAdv advs))
_ -> adv
onAP :: Tree GAP_ -> Tree GAP_
onAP ap = case ap of
GAdAP ada ap -> GAdAP ada (onAP ap)
GAdvAP ap adv -> GAdvAP (onAP ap) (onAdv adv)
GComparA a np -> GComparA a (onNP np)
_ -> ap ----composOp onNP np
old2new :: Tree a -> Tree a old2new :: Tree a -> Tree a
old2new t = case t of old2new t = case t of