From 3a064468c2d302cceefbcdd56421950453537b42 Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Wed, 26 Feb 2014 18:03:52 +0000
Subject: [PATCH] top-level transfer for converting trees; lexicon not included

---
 lib/src/experimental/transfer/Both.hs       | 6 ++++--
 lib/src/experimental/transfer/ONTransfer.hs | 8 ++++++++
 lib/src/experimental/transfer/Old2New.hs    | 4 ++--
 3 files changed, 14 insertions(+), 4 deletions(-)
 create mode 100644 lib/src/experimental/transfer/ONTransfer.hs

diff --git a/lib/src/experimental/transfer/Both.hs b/lib/src/experimental/transfer/Both.hs
index 465a1b38e..d1f43b8b7 100644
--- a/lib/src/experimental/transfer/Both.hs
+++ b/lib/src/experimental/transfer/Both.hs
@@ -292,7 +292,9 @@ type GFloat = Tree GFloat_
 data GFloat_
 
 data Tree :: * -> * where
-----  GEMeta :: Int -> [forall a . Tree a] -> Tree a
+
+  GEMeta :: Int -> [Tree a] -> Tree GPhr_
+
   GAdAP :: GAdA -> GAP -> Tree GAP_
   GAdjOrd :: GOrd -> Tree GAP_
   GAdvAP :: GAP -> GAdv -> Tree GAP_
@@ -2720,7 +2722,7 @@ instance Gf GVV where
 instance Compos Tree where
   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
     GAdjOrd x1 -> r GAdjOrd `a` f x1
diff --git a/lib/src/experimental/transfer/ONTransfer.hs b/lib/src/experimental/transfer/ONTransfer.hs
new file mode 100644
index 000000000..b3704575e
--- /dev/null
+++ b/lib/src/experimental/transfer/ONTransfer.hs
@@ -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
\ No newline at end of file
diff --git a/lib/src/experimental/transfer/Old2New.hs b/lib/src/experimental/transfer/Old2New.hs
index 919830e4e..a9e1cdf6a 100644
--- a/lib/src/experimental/transfer/Old2New.hs
+++ b/lib/src/experimental/transfer/Old2New.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fglasgow-exts #-}
 
-module Old2New where
+module Old2New (transfer) where
 import PGF hiding (Tree)
 import qualified PGF
 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)
 
 -- NP
-  GRelNP np rs -> GRelNP (on np) (on rs)
 
 -- Adv
   GComparAdvAdjS cadv a s -> error "GComparAdvAdjS cadv a (onS s)"
@@ -89,6 +88,7 @@ getAdvs :: GVP -> ([GPrAdv_none],GVP)
 getAdvs vp = case vp of
   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)
+  _ -> ([],vp)
 
 appAdvCl :: [GPrAdv_none] -> GPrCl_none -> GPrCl_none
 appAdvCl advs cl = foldr GAdvCl_none cl advs