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

top-level transfer for converting trees; lexicon not included

Browse Source
This commit is contained in:
aarne
2014-02-26 18:03:52 +00:00
parent 88c06f74fc
commit 3a064468c2
3 changed files with 14 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lib/src/experimental/transfer/Both.hs
View File

@@ -292,7 +292,9 @@ type GFloat = Tree GFloat_
data GFloat_ data GFloat_
data Tree :: * -> * where data Tree :: * -> * where
---- GEMeta :: Int -> [forall a . Tree a] -> Tree a
GEMeta :: Int -> [Tree a] -> Tree GPhr_
GAdAP :: GAdA -> GAP -> Tree GAP_ GAdAP :: GAdA -> GAP -> Tree GAP_
GAdjOrd :: GOrd -> Tree GAP_ GAdjOrd :: GOrd -> Tree GAP_
GAdvAP :: GAP -> GAdv -> Tree GAP_ GAdvAP :: GAP -> GAdv -> Tree GAP_
@@ -2720,7 +2722,7 @@ instance Gf GVV where
instance Compos Tree where instance Compos Tree where
compos r a f t = case t of compos r a f t = case t of
---- GEMeta m x1 -> r (GEMeta m) `a` foldr (a . a (r (:)) . f) (r []) x1 GEMeta m x1 -> r (GEMeta m) `a` foldr (a . a (r (:)) . f) (r []) x1
GAdAP x1 x2 -> r GAdAP `a` f x1 `a` f x2 GAdAP x1 x2 -> r GAdAP `a` f x1 `a` f x2
GAdjOrd x1 -> r GAdjOrd `a` f x1 GAdjOrd x1 -> r GAdjOrd `a` f x1

8
lib/src/experimental/transfer/ONTransfer.hs Normal file
View File

@@ -0,0 +1,8 @@
module Main where
import qualified PGF
import Old2New
main = interact (unlines . map trans . lines)
trans = maybe "" (PGF.showExpr [] . transfer) . PGF.readExpr

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

@@ -1,6 +1,6 @@
{-# OPTIONS_GHC -fglasgow-exts #-} {-# OPTIONS_GHC -fglasgow-exts #-}
module Old2New where module Old2New (transfer) where
import PGF hiding (Tree) import PGF hiding (Tree)
import qualified PGF import qualified PGF
import PGF.Data import PGF.Data
@@ -39,7 +39,6 @@ on t = case t of
GUseRCl (GTTAnt t a) p (GRelSlash rp cls) -> GRelSlash_none rp (onClSlash t a p cls) GUseRCl (GTTAnt t a) p (GRelSlash rp cls) -> GRelSlash_none rp (onClSlash t a p cls)
-- NP -- NP
GRelNP np rs -> GRelNP (on np) (on rs)
-- Adv -- Adv
GComparAdvAdjS cadv a s -> error "GComparAdvAdjS cadv a (onS s)" GComparAdvAdjS cadv a s -> error "GComparAdvAdjS cadv a (onS s)"
@@ -89,6 +88,7 @@ getAdvs :: GVP -> ([GPrAdv_none],GVP)
getAdvs vp = case vp of getAdvs vp = case vp of
GAdvVP vp1 adv -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdv adv],vp2) GAdvVP vp1 adv -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdv adv],vp2)
GAdVVP adv vp1 -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdV adv],vp2) GAdVVP adv vp1 -> let (advs,vp2) = getAdvs vp1 in (advs ++ [GLiftAdV adv],vp2)
_ -> ([],vp)
appAdvCl :: [GPrAdv_none] -> GPrCl_none -> GPrCl_none appAdvCl :: [GPrAdv_none] -> GPrCl_none -> GPrCl_none
appAdvCl advs cl = foldr GAdvCl_none cl advs appAdvCl advs cl = foldr GAdvCl_none cl advs