Added treatment of transfer modules. Aggregation is an example.

29 files changed, 311 insertions, 50 deletions

diff --git a/grammars/aggregation/Abstract.gf b/grammars/aggregation/Abstract.gf
new file mode 100644
index 000000000..719bfe150
--- /dev/null
+++ b/grammars/aggregation/Abstract.gf
@@ -0,0 +1,57 @@
+-- testing transfer: aggregation by def definitions. AR 12/4/2003 -- 9/10
+
+--   p "Mary runs or John runs and John walks" | l -transfer=Aggregation
+--   Mary runs or John runs and walks
+--   Mary or John runs and John walks
+
+-- The two results are due to ambiguity in parsing. Thus it is not spurious!
+
+abstract Abstract = {
+
+cat 
+  S ; NP ; VP ; Conj ;
+
+fun
+  Pred : NP -> VP -> S ;
+  ConjS : Conj -> S -> S -> S ;
+  ConjVP : Conj -> VP -> VP -> VP ;
+  ConjNP : Conj -> NP -> NP -> NP ;
+
+  John, Mary, Bill : NP ;
+  Walk, Run, Swim : VP ;
+  And, Or : Conj ;
+
+fun aggreg : S -> S ;
+def 
+  aggreg (ConjS c (Pred Q F) B) = aggrAux c Q F B ;
+  aggreg (ConjS c A          B) = ConjS c (aggreg A) (aggreg B) ;
+  aggreg A = A ;
+
+-- this auxiliary makes pattern matching on NP to test equality
+
+fun aggrAux : Conj -> NP -> VP -> S -> S ;
+def 
+  -- aggregate verbs with shared subject
+  aggrAux c John F    (Pred John G)    = Pred John (ConjVP c F G) ;
+  aggrAux c Mary F    (Pred Mary G)    = Pred Mary (ConjVP c F G) ;
+  aggrAux c Bill F    (Pred Bill G)    = Pred Bill (ConjVP c F G) ;
+
+  -- aggregate subjects with shared verbs
+  aggrAux c Q    Run  (Pred R    Run)  = Pred (ConjNP c Q R) Run ;
+  aggrAux c Q    Walk (Pred R    Walk) = Pred (ConjNP c Q R) Walk ;
+  aggrAux c Q    Swim (Pred R    Swim) = Pred (ConjNP c Q R) Swim ;
+
+  -- this case takes care of munching
+  aggrAux c Q    F    (ConjS e A B) = aggrAux c Q F (aggreg (ConjS e A B)) ;
+
+  aggrAux c Q    F    B            = ConjS c (Pred Q F) (aggreg B) ;
+
+-- unfortunately we cannot test string equality for Name : String -> NP ;
+-- It would also be tedious to test the equality of complex
+-- NPs and VPs, but not impossible.
+
+-- have to add these, otherwise constants are not constructor patterns!
+
+data NP = John | Mary | Bill ;
+data VP = Run | Walk | Swim ;
+}
diff --git a/grammars/aggregation/Aggregation.gf b/grammars/aggregation/Aggregation.gf
new file mode 100644
index 000000000..116629422
--- /dev/null
+++ b/grammars/aggregation/Aggregation.gf
@@ -0,0 +1,5 @@
+transfer Aggregation : Abstract -> Abstract = {
+
+  transfer S : S -> S = aggreg ;
+
+}
diff --git a/grammars/aggregation/English.gf b/grammars/aggregation/English.gf
new file mode 100644
index 000000000..21da16b23
--- /dev/null
+++ b/grammars/aggregation/English.gf
@@ -0,0 +1,18 @@
+concrete English of Abstract = {
+
+pattern
+  Pred np vp = np ++ vp ;
+  ConjS c A  B = A ++ c ++ B ;
+  ConjVP c A  B = A ++ c ++ B ;
+  ConjNP c A  B = A ++ c ++ B ;
+  
+  John = "John" ;
+  Mary = "Mary" ;
+  Bill = "Bill" ;
+  Walk = "walks" ;
+  Run = "runs" ;
+  Swim = "swims" ;
+
+  And = "and" ;
+  Or = "or" ;
+}
diff --git a/grammars/aggregation/transfer.gf b/grammars/aggregation/transfer.gf
new file mode 100644
index 000000000..0f4e12097
--- /dev/null
+++ b/grammars/aggregation/transfer.gf
@@ -0,0 +1,75 @@
+-- testing transfer: aggregation by def definitions. AR 12/4/2003
+
+--   p "Mary runs or John runs and John walks" | wt -c aggreg | l
+--   Mary runs or John runs and walks
+--   Mary or John runs and John walks
+-- The two results are due to ambiguity in parsing. Thus it is not spurious!
+
+flags transfer=aggreg ;
+
+cat 
+  S ; NP ; VP ; Conj ;
+
+fun
+  Pred : NP -> VP -> S ;
+  ConjS : Conj -> S -> S -> S ;
+  ConjVP : Conj -> VP -> VP -> VP ;
+  ConjNP : Conj -> NP -> NP -> NP ;
+
+  John, Mary, Bill : NP ;
+  Walk, Run, Swim : VP ;
+  And, Or : Conj ;
+
+pattern
+  Pred np vp = np ++ vp ;
+  ConjS c A  B = A ++ c ++ B ;
+  ConjVP c A  B = A ++ c ++ B ;
+  ConjNP c A  B = A ++ c ++ B ;
+  
+  John = "John" ;
+  Mary = "Mary" ;
+  Bill = "Bill" ;
+  Walk = "walks" ;
+  Run = "runs" ;
+  Swim = "swims" ;
+
+
+  And = "and" ;
+  Or = "or" ;
+
+-- aggregation transformation
+
+fun aggreg : S -> S ;
+def 
+  aggreg (ConjS c (Pred Q F) B) = aggrAux c Q F B ;
+  aggreg (ConjS c A          B) = ConjS c (aggreg A) (aggreg B) ;
+  aggreg A = A ;
+
+-- this auxiliary makes pattern matching on NP to test equality
+
+fun aggrAux : Conj -> NP -> VP -> S -> S ;
+def 
+  -- aggregate verbs with shared subject
+  aggrAux c John F    (Pred John G)    = Pred John (ConjVP c F G) ;
+  aggrAux c Mary F    (Pred Mary G)    = Pred Mary (ConjVP c F G) ;
+  aggrAux c Bill F    (Pred Bill G)    = Pred Bill (ConjVP c F G) ;
+
+  -- aggregate subjects with shared verbs
+  aggrAux c Q    Run  (Pred R    Run)  = Pred (ConjNP c Q R) Run ;
+  aggrAux c Q    Walk (Pred R    Walk) = Pred (ConjNP c Q R) Walk ;
+  aggrAux c Q    Swim (Pred R    Swim) = Pred (ConjNP c Q R) Swim ;
+
+  -- this case takes care of munching
+  aggrAux c Q    F    (ConjS e A B) = aggrAux c Q F (aggreg (ConjS e A B)) ;
+
+  aggrAux c Q    F    B            = ConjS c (Pred Q F) (aggreg B) ;
+
+-- unfortunately we cannot test string equality for Name : String -> NP ;
+-- It would also be tedious to test the equality of complex
+-- NPs and VPs, but not impossible.
+
+-- have to add these, otherwise constants are not constructor patterns!
+
+data NP = John | Mary | Bill ;
+data VP = Run | Walk | Swim ;
+
diff --git a/grammars/numerals/Trans.gf b/grammars/numerals/Trans.gf
new file mode 100644
index 000000000..4d46bc7f1
--- /dev/null
+++ b/grammars/numerals/Trans.gf
@@ -0,0 +1,3 @@
+transfer Trans : Nat -> Nat = {
+  transfer Nat = nat2bin ;
+}
diff --git a/grammars/prelude/Predef.gf b/grammars/prelude/Predef.gf
index a91681af6..ec56cbfe4 100644
--- a/grammars/prelude/Predef.gf
+++ b/grammars/prelude/Predef.gf
@@ -5,21 +5,21 @@ resource Predef = {
   -- this type is for internal use only
   param PBool = PTrue | PFalse ;
 
-  -- these operations have their definitions in AppPredefined.hs
-  oper Int : Type = variants {} ; ----
+  -- these operations have their proper definitions in AppPredefined.hs
 
-  oper length : Tok ->        Int  = variants {} ;
-  oper drop   : Int -> Tok -> Tok  = variants {} ;
-  oper take   : Int -> Tok -> Tok  = variants {} ;
-  oper tk     : Int -> Tok -> Tok  = variants {} ;
-  oper dp     : Int -> Tok -> Tok  = variants {} ;
-  oper eqInt  : Int -> Int -> PBool = variants {} ; 
-  oper plus   : Int -> Int -> Int  = variants {} ;
+  oper Int : Type = variants {} ;                      -- the type of integers
 
-  oper eqStr  : Tok -> Tok -> PBool   = variants {} ; 
-  oper eqTok  : (P : Type) -> P -> P -> PBool = variants {} ; 
-  oper show   : (P : Type) -> P -> Tok = variants {} ; 
-  oper read   : (P : Type) -> Tok -> P = variants {} ; 
+  oper length : Tok ->        Int      = variants {} ; -- length of string
+  oper drop   : Int -> Tok -> Tok      = variants {} ; -- drop prefix of length
+  oper take   : Int -> Tok -> Tok      = variants {} ; -- take prefix of length
+  oper tk     : Int -> Tok -> Tok      = variants {} ; -- drop suffix of length
+  oper dp     : Int -> Tok -> Tok      = variants {} ; -- take suffix of length
+  oper eqInt  : Int -> Int -> PBool    = variants {} ; -- test if equal integers
+  oper plus   : Int -> Int -> Int      = variants {} ; -- add integers
+  oper eqStr  : Tok -> Tok -> PBool    = variants {} ; -- test if equal strings
+  oper occur  : Tok -> Tok -> PBool    = variants {} ; -- test if occurs as substring
+  oper show   : (P : Type) -> P -> Tok = variants {} ; -- convert param to string
+  oper read   : (P : Type) -> Tok -> P = variants {} ; -- convert string to param
 
   } ;
 
diff --git a/src/GF/API.hs b/src/GF/API.hs
index 262c65382..db2e4a066 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -17,12 +17,12 @@ import PPrCF
 import CFIdent
 import PGrammar
 import Randomized (mkRandomTree)
-import Zipper
 
 import MMacros
 import qualified Macros as M
 import TypeCheck
 import CMacros
+import Transfer
 
 import Option
 import Custom
@@ -47,6 +47,7 @@ import Arch (myStdGen)
 import UTF8
 import Operations
 import UseIO
+import Zipper
 
 import List (nub)
 import Monad (liftM)
@@ -161,20 +162,24 @@ optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String
 optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr
 
 optLinearizeTree :: Options -> GFGrammar -> Tree -> Err String
-optLinearizeTree opts gr t = case getOptVal opts markLin of
-  Just mk
-    | mk == markOptXML    -> lin markXML t
-    | mk == markOptJava   -> lin markXMLjgf t
-    | mk == markOptStruct -> lin markBracket t
-    | mk == markOptFocus  -> lin markFocus t
-    | otherwise           -> lin noMark t 
-  _ -> lin noMark t
+optLinearizeTree opts gr t = case getOptVal opts transferFun of
+  Just m -> useByTransfer flin g (I.identC m) t
+  _ -> flin t
  where
-   lin mk
+  flin = case getOptVal opts markLin of
+    Just mk
+     | mk == markOptXML    -> lin markXML
+     | mk == markOptJava   -> lin markXMLjgf
+     | mk == markOptStruct -> lin markBracket
+     | mk == markOptFocus  -> lin markFocus
+     | otherwise           -> lin noMark
+    _ -> lin noMark
+
+  lin mk
     | oElem showRecord opts = liftM prt . linearizeNoMark g c
     | otherwise             = return . linTree2string mk g c
-   g = grammar gr
-   c = cncId gr
+  g = grammar gr
+  c = cncId gr
 
 {- ----
         untoksl . lin where
@@ -208,13 +213,22 @@ optLinearizeArgForm opts sgr fs ts0 = untoksl $ lin ts where
 optParseArg :: Options -> GFGrammar -> String -> [Tree]
 optParseArg opts gr =  err (const []) id . optParseArgErr opts gr
 
+optParseArgAny :: Options -> [GFGrammar] -> String -> [Tree]
+optParseArgAny opts grs s = concat [pars gr s | gr <- grs] where
+  pars gr = optParseArg opts gr --- grammar options!
+
 optParseArgErr :: Options -> GFGrammar -> String -> Err [Tree]
 optParseArgErr opts gr = liftM fst . optParseArgErrMsg opts gr
 
 optParseArgErrMsg :: Options -> GFGrammar -> String -> Err ([Tree],String)
-optParseArgErrMsg opts gr s = 
+optParseArgErrMsg opts gr s = do
   let cat = firstCatOpts opts gr
-  in parseStringMsg opts gr cat s
+      g   = grammar gr
+  (ts,m) <- parseStringMsg opts gr cat s
+  ts' <- case getOptVal opts transferFun of
+    Just m -> mkByTransfer (const $ return ts) g (I.identC m) s
+    _ -> return ts
+  return (ts',m)
 
 -- analyses word by word
 morphoAnalyse :: Options -> GFGrammar -> String -> String
diff --git a/src/GF/Canon/AbsGFC.hs b/src/GF/Canon/AbsGFC.hs
index 56adb3b4e..a95dbce0f 100644
--- a/src/GF/Canon/AbsGFC.hs
+++ b/src/GF/Canon/AbsGFC.hs
@@ -5,6 +5,7 @@ import Ident --H
 -- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
+
 data Canon =
    Gr [Module]
   deriving (Eq,Ord,Show)
@@ -17,6 +18,7 @@ data ModType =
    MTAbs Ident
  | MTCnc Ident Ident
  | MTRes Ident
+ | MTTrans Ident Ident Ident
   deriving (Eq,Ord,Show)
 
 data Extend =
@@ -36,6 +38,7 @@ data Flag =
 data Def =
    AbsDCat Ident [Decl] [CIdent]
  | AbsDFun Ident Exp Exp
+ | AbsDTrans Ident Exp
  | ResDPar Ident [ParDef]
  | ResDOper Ident CType Term
  | CncDCat Ident CType Term Term
diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs
index e42c273cb..1a677e1a9 100644
--- a/src/GF/Canon/CanonToGrammar.hs
+++ b/src/GF/Canon/CanonToGrammar.hs
@@ -29,6 +29,7 @@ canon2sourceModule (i,mi) = do
             return (a', M.MTConcrete a') 
           M.MTAbstract -> return (i',M.MTAbstract) --- c' not needed
           M.MTResource -> return (i',M.MTResource) --- c' not needed
+          M.MTTransfer x y -> return (i',M.MTTransfer x y) --- c' not needed
       defs   <- mapMTree redInfo $ M.jments m
       return $ M.ModMod $ M.Module mt flags e os defs
     _ -> Bad $ "cannot decompile module type"
@@ -50,6 +51,8 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
       return $ G.AbsCat (Yes cont) (Yes (map (uncurry G.Q) fs))
     AbsFun typ df -> do
       return $ G.AbsFun (Yes typ) (Yes df)
+    AbsTrans t -> do
+      return $ G.AbsTrans t
 
     ResPar par -> liftM (G.ResParam . Yes) $ mapM redParam par
 
diff --git a/src/GF/Canon/GFC.hs b/src/GF/Canon/GFC.hs
index 63b697a35..48c77dfe3 100644
--- a/src/GF/Canon/GFC.hs
+++ b/src/GF/Canon/GFC.hs
@@ -27,6 +27,7 @@ type CanonAbs = M.Module Ident Option Info
 data Info = 
    AbsCat  A.Context [A.Fun]
  | AbsFun  A.Type A.Term
+ | AbsTrans A.Term
 
  | ResPar  [ParDef]
  | ResOper CType Term     -- global constant
diff --git a/src/GF/Canon/LexGFC.hs b/src/GF/Canon/LexGFC.hs
index 56048dce3..a4b4de7d7 100644
--- a/src/GF/Canon/LexGFC.hs
+++ b/src/GF/Canon/LexGFC.hs
@@ -52,7 +52,7 @@ tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
   isResWord s = isInTree s $
-    B "lin" (B "concrete" (B "abstract" (B "Type" (B "Str" N N) N) (B "cat" N N)) (B "fun" (B "flags" (B "data" N N) N) (B "in" N N))) (B "param" (B "open" (B "of" (B "lincat" N N) N) (B "oper" N N)) (B "table" (B "resource" (B "pre" N N) N) (B "variants" N N)))
+    B "lincat" (B "data" (B "abstract" (B "Type" (B "Str" N N) N) (B "concrete" (B "cat" N N) N)) (B "in" (B "fun" (B "flags" N N) N) (B "lin" N N))) (B "pre" (B "oper" (B "open" (B "of" N N) N) (B "param" N N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
 
 data BTree = N | B String BTree BTree deriving (Show)
 
@@ -79,13 +79,13 @@ tokens_acts = [("ident",ident),("int",int),("pTSpec",pTSpec),("string",string)]
 tokens_lx :: [(Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))]
 tokens_lx = [lx__0_0,lx__1_0,lx__2_0,lx__3_0,lx__4_0,lx__5_0,lx__6_0,lx__7_0,lx__8_0,lx__9_0,lx__10_0,lx__11_0]
 lx__0_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
-lx__0_0 = (False,[],-1,(('\t','\255'),[('\t',1),('\n',1),('\v',1),('\f',1),('\r',1),(' ',1),('!',6),('"',8),('$',6),('(',6),(')',6),('*',2),('+',5),(',',6),('-',3),('.',6),('/',6),('0',11),('1',11),('2',11),('3',11),('4',11),('5',11),('6',11),('7',11),('8',11),('9',11),(':',6),(';',6),('<',6),('=',4),('>',6),('?',6),('@',6),('A',7),('B',7),('C',7),('D',7),('E',7),('F',7),('G',7),('H',7),('I',7),('J',7),('K',7),('L',7),('M',7),('N',7),('O',7),('P',7),('Q',7),('R',7),('S',7),('T',7),('U',7),('V',7),('W',7),('X',7),('Y',7),('Z',7),('[',6),('\\',6),(']',6),('_',6),('a',7),('b',7),('c',7),('d',7),('e',7),('f',7),('g',7),('h',7),('i',7),('j',7),('k',7),('l',7),('m',7),('n',7),('o',7),('p',7),('q',7),('r',7),('s',7),('t',7),('u',7),('v',7),('w',7),('x',7),('y',7),('z',7),('{',6),('|',6),('}',6),('\192',7),('\193',7),('\194',7),('\195',7),('\196',7),('\197',7),('\198',7),('\199',7),('\200',7),('\201',7),('\202',7),('\203',7),('\204',7),('\205',7),('\206',7),('\207',7),('\208',7),('\209',7),('\210',7),('\211',7),('\212',7),('\213',7),('\214',7),('\216',7),('\217',7),('\218',7),('\219',7),('\220',7),('\221',7),('\222',7),('\223',7),('\224',7),('\225',7),('\226',7),('\227',7),('\228',7),('\229',7),('\230',7),('\231',7),('\232',7),('\233',7),('\234',7),('\235',7),('\236',7),('\237',7),('\238',7),('\239',7),('\240',7),('\241',7),('\242',7),('\243',7),('\244',7),('\245',7),('\246',7),('\248',7),('\249',7),('\250',7),('\251',7),('\252',7),('\253',7),('\254',7),('\255',7)]))
+lx__0_0 = (False,[],-1,(('\t','\255'),[('\t',1),('\n',1),('\v',1),('\f',1),('\r',1),(' ',1),('!',6),('"',8),('$',6),('(',6),(')',6),('*',3),('+',5),(',',6),('-',2),('.',6),('/',6),('0',11),('1',11),('2',11),('3',11),('4',11),('5',11),('6',11),('7',11),('8',11),('9',11),(':',6),(';',6),('<',6),('=',4),('>',6),('?',6),('@',6),('A',7),('B',7),('C',7),('D',7),('E',7),('F',7),('G',7),('H',7),('I',7),('J',7),('K',7),('L',7),('M',7),('N',7),('O',7),('P',7),('Q',7),('R',7),('S',7),('T',7),('U',7),('V',7),('W',7),('X',7),('Y',7),('Z',7),('[',6),('\\',6),(']',6),('_',6),('a',7),('b',7),('c',7),('d',7),('e',7),('f',7),('g',7),('h',7),('i',7),('j',7),('k',7),('l',7),('m',7),('n',7),('o',7),('p',7),('q',7),('r',7),('s',7),('t',7),('u',7),('v',7),('w',7),('x',7),('y',7),('z',7),('{',6),('|',6),('}',6),('\192',7),('\193',7),('\194',7),('\195',7),('\196',7),('\197',7),('\198',7),('\199',7),('\200',7),('\201',7),('\202',7),('\203',7),('\204',7),('\205',7),('\206',7),('\207',7),('\208',7),('\209',7),('\210',7),('\211',7),('\212',7),('\213',7),('\214',7),('\216',7),('\217',7),('\218',7),('\219',7),('\220',7),('\221',7),('\222',7),('\223',7),('\224',7),('\225',7),('\226',7),('\227',7),('\228',7),('\229',7),('\230',7),('\231',7),('\232',7),('\233',7),('\234',7),('\235',7),('\236',7),('\237',7),('\238',7),('\239',7),('\240',7),('\241',7),('\242',7),('\243',7),('\244',7),('\245',7),('\246',7),('\248',7),('\249',7),('\250',7),('\251',7),('\252',7),('\253',7),('\254',7),('\255',7)]))
 lx__1_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
 lx__1_0 = (True,[(0,"",[],Nothing,Nothing)],-1,(('\t',' '),[('\t',1),('\n',1),('\v',1),('\f',1),('\r',1),(' ',1)]))
 lx__2_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
-lx__2_0 = (False,[],-1,(('*','*'),[('*',6)]))
+lx__2_0 = (False,[],-1,(('>','>'),[('>',6)]))
 lx__3_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
-lx__3_0 = (False,[],-1,(('>','>'),[('>',6)]))
+lx__3_0 = (False,[],-1,(('*','*'),[('*',6)]))
 lx__4_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
 lx__4_0 = (True,[(1,"pTSpec",[],Nothing,Nothing)],-1,(('>','>'),[('>',6)]))
 lx__5_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs
index 25feb5a47..d747634d2 100644
--- a/src/GF/Canon/MkGFC.hs
+++ b/src/GF/Canon/MkGFC.hs
@@ -21,6 +21,7 @@ canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
             MTAbs a -> (a,M.MTAbstract)
             MTRes a -> (a,M.MTResource)
             MTCnc a x -> (a,M.MTConcrete x)
+            MTTrans a x y -> (a,M.MTTransfer (M.OSimple x) (M.OSimple y))
       in (a,M.ModMod (M.Module mt' flags (ee e) (oo os) defs'))
   ee (Ext m) = Just m
   ee _ = Nothing
@@ -37,6 +38,7 @@ info2mod m = case m of
              M.MTAbstract -> MTAbs a
              M.MTResource -> MTRes a
              M.MTConcrete x -> MTCnc a x
+             M.MTTransfer (M.OSimple x) (M.OSimple y) -> MTTrans a x y
       in
         Mod mt' (gfcE me) (gfcO os) flags defs'
  where
@@ -51,6 +53,7 @@ defs2infos = sorted2tree . map def2info
 def2info d = case d of
   AbsDCat c cont fs -> (c,AbsCat (trCont cont) (trFs fs))
   AbsDFun c ty df   -> (c,AbsFun (trExp ty) (trExp df))
+  AbsDTrans c t     -> (c,AbsTrans (trExp t))
   ResDPar c    df   -> (c,ResPar df)
   ResDOper c ty df  -> (c,ResOper ty df)
   CncDCat c ty df pr   -> (c, CncCat ty df pr)
@@ -95,6 +98,7 @@ infos2defs = map info2def . tree2list
 info2def d = case d of
   (c,AbsCat cont fs)    -> AbsDCat c (rtCont cont) (rtFs fs)
   (c,AbsFun ty df)      -> AbsDFun c (rtExp ty) (rtExp df)
+  (c,AbsTrans t)        -> AbsDTrans c (rtExp t)
   (c,ResPar    df)      -> ResDPar c df
   (c,ResOper ty df)     -> ResDOper c ty df
   (c,CncCat ty df pr)   -> CncDCat c ty df pr
diff --git a/src/GF/Canon/PrintGFC.hs b/src/GF/Canon/PrintGFC.hs
index bc89ffd6f..81bea7b34 100644
--- a/src/GF/Canon/PrintGFC.hs
+++ b/src/GF/Canon/PrintGFC.hs
@@ -97,7 +97,7 @@ instance Print ModType where
    MTAbs id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
    MTCnc id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
    MTRes id -> prPrec i 0 (concat [["resource"] , prt 0 id])
-
+   MTTrans id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open])
 
 instance Print Extend where
   prt i e = case e of
@@ -123,6 +123,7 @@ instance Print Def where
   prt i e = case e of
    AbsDCat id decls cidents -> prPrec i 0 (concat [["cat"] , prt 0 id , ["["] , prt 0 decls , ["]"] , ["="] , prt 0 cidents])
    AbsDFun id exp0 exp -> prPrec i 0 (concat [["fun"] , prt 0 id , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
+   AbsDTrans id exp -> prPrec i 0 (concat [["transfer"] , prt 0 id , ["="] , prt 0 exp])
    ResDPar id pardefs -> prPrec i 0 (concat [["param"] , prt 0 id , ["="] , prt 0 pardefs])
    ResDOper id ctype term -> prPrec i 0 (concat [["oper"] , prt 0 id , [":"] , prt 0 ctype , ["="] , prt 0 term])
    CncDCat id ctype term0 term -> prPrec i 0 (concat [["lincat"] , prt 0 id , ["="] , prt 0 ctype , ["="] , prt 0 term0 , [";"] , prt 0 term])
diff --git a/src/GF/Canon/SkelGFC.hs b/src/GF/Canon/SkelGFC.hs
index 955cc442f..2b4323356 100644
--- a/src/GF/Canon/SkelGFC.hs
+++ b/src/GF/Canon/SkelGFC.hs
@@ -29,6 +29,7 @@ transModType x = case x of
   MTAbs id  -> failure x
   MTCnc id0 id  -> failure x
   MTRes id  -> failure x
+  MTTrans id0 id1 id  -> failure x
 
 
 transExtend :: Extend -> Result
@@ -52,6 +53,7 @@ transDef :: Def -> Result
 transDef x = case x of
   AbsDCat id decls cidents  -> failure x
   AbsDFun id exp0 exp  -> failure x
+  AbsDTrans id exp  -> failure x
   ResDPar id pardefs  -> failure x
   ResDOper id ctype term  -> failure x
   CncDCat id ctype term0 term  -> failure x
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 544214cb9..07151d8b7 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -42,6 +42,10 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
       js' <- mapMTree (checkAbsInfo gr name) js
       return $ (name, ModMod (Module mt fs me ops js')) : ms
 
+    MTTransfer a b -> do
+      js' <- mapMTree (checkAbsInfo gr name) js
+      return $ (name, ModMod (Module mt fs me ops js')) : ms
+
     MTResource -> do
       js' <- mapMTree (checkResInfo gr) js
       return $ (name, ModMod (Module mt fs me ops js')) : ms
diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs
index 23833a3c2..07708dd3c 100644
--- a/src/GF/Compile/GrammarToCanon.hs
+++ b/src/GF/Compile/GrammarToCanon.hs
@@ -43,6 +43,7 @@ redModInfo (c,info) = do
            return (a', MTConcrete a') 
          MTAbstract -> return (c',MTAbstract) --- c' not needed
          MTResource -> return (c',MTResource) --- c' not needed
+         MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed
       defss <- mapM (redInfo a) $ tree2list $ jments m
       defs  <- return $ sorted2tree $ concat defss  -- sorted, but reduced
       return $ ModMod $ Module mt flags e os defs
@@ -54,6 +55,7 @@ redModInfo (c,info) = do
        _ -> return Nothing
      os' <- mapM (\ (OQualif _ i) -> liftM OSimple (redIdent i)) $ opens m
      return (e',os')
+   om = OSimple . openedModule --- normalizing away qualif
 
 redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]
 redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
@@ -69,6 +71,8 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
                  Yes t -> t
                  _ -> EData --- data vs. primitive
       returns c' $ C.AbsFun typ df
+    AbsTrans t -> 
+      returns c' $ C.AbsTrans t
 
     ResParam (Yes ps) -> do
       ps' <- mapM redParam ps
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index eb6f6dcb9..a4d9b9365 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -117,7 +117,7 @@ tree2status o = case o of
 buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
 buildStatus gr c mo = let mo' = self2status c mo in case mo of
   ModMod m -> do
-    let ops  = opens m
+    let ops  = allOpens m
     mods <- mapM (lookupModule gr . openedModule) ops
     let sts = map modInfo2status $ zip ops mods    
     return $ if isModCnc m
@@ -130,10 +130,14 @@ modInfo2status (o,i) = (o,case i of
   )
 
 self2status :: Ident -> SourceModInfo -> StatusTree
-self2status c i = case i of
-  ModMod m -> mapTree (info2status (Just c)) (jments m)   -- qualify internal
----  ModMod m -> mapTree (resInfo2status Nothing) (jments m)
--- change Lookup.qualifAnnot if you change this
+self2status c i = mapTree (info2status (Just c)) js where   -- qualify internal
+  js = case i of
+    ModMod m 
+      | isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m 
+      | otherwise -> jments m
+  noTrans (_,d) = case d of  -- to enable other than transfer js in transfer module 
+    AbsTrans _ -> False
+    _ -> True
 
 forceQualif o = case o of
   OSimple i   -> OQualif i i
@@ -145,6 +149,7 @@ renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $
   AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
                                   (renPerh (mapM rent) pfs)
   AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
+  AbsTrans f -> liftM AbsTrans (rent f)
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
   ResParam pp -> liftM ResParam (renPerh (mapM (renameParam status)) pp)
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index f59c910b0..14f35a1d4 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -26,6 +26,7 @@ appPredefined t = case t of
       ("tk",   EInt i, K s) -> K (take (max 0 (length s - i)) s)
       ("dp",   EInt i, K s) -> K (drop (max 0 (length s - i)) s)
       ("eqStr",K s,    K t) -> if s == t then predefTrue else predefFalse
+      ("occur",K s,    K t) -> if substring s t then predefTrue else predefFalse
       ("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse
       ("plus", EInt i, EInt j) -> EInt $ i+j
       ("show", _, t) -> K $ prt t
@@ -49,3 +50,10 @@ str2tag s = case s of
 
 predefTrue = Q (IC "Predef") (IC "PTrue")
 predefFalse = Q (IC "Predef") (IC "PFalse")
+
+substring :: String -> String -> Bool
+substring s t = case (s,t) of
+  (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds
+  ([],_) -> True
+  _ -> False
+
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index ee018791a..a2978d6b3 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -26,7 +26,7 @@ type SourceCnc = Module Ident Option Info
 data Info =                  
    AbsCat   (Perh Context) (Perh [Term])   -- constructors; must be Id or QId
  | AbsFun   (Perh Type) (Perh Term)        -- Yes f = canonical
- | AbsTrans Ident
+ | AbsTrans Term
 
 -- judgements in resource
  | ResParam (Perh [Param])
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 8400d9af5..43a8c580a 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -48,6 +48,21 @@ lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
         _ -> prtBad "unknown category" c
     _ -> Bad $ prt m +++ "is not an abstract module"
 
+-- lookup for transfer function: transfer-module-name, category name
+
+lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term
+lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
+  mi   <- lookupModule gr m
+  case mi of
+    ModMod mo -> do
+      info <- lookupInfo mo c
+      case info of
+        C.AbsTrans t -> return t
+        C.AnyInd _ n  -> lookupTransfer gr n c
+        _ -> prtBad "cannot transfer function for" c
+    _ -> Bad $ prt m +++ "is not a transfer module"
+
+
 ---- should be revised (20/9/2003)
 isPrimitiveFun :: GFCGrammar -> Fun -> Bool
 isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index 01b789f8f..bae22219f 100644
--- a/src/GF/Infra/Modules.hs
+++ b/src/GF/Infra/Modules.hs
@@ -66,6 +66,10 @@ openedModule o = case o of
   OSimple m -> m
   OQualif _ m -> m
 
+allOpens m = case mtype m of
+  MTTransfer a b -> a : b : opens m
+  _ -> opens m
+
 -- initial dependency list
 depPathModule :: Ord i => Module i f a -> [OpenSpec i]
 depPathModule m = fors m ++ exts m ++ opens m where
@@ -176,6 +180,10 @@ isModCnc m = case mtype m of
   MTConcrete _ -> True
   _ -> False
 
+isModTrans m = case mtype m of
+  MTTransfer _ _ -> True
+  _ -> False
+
 sameMType m n = case (m,n) of
   (MTConcrete _, MTConcrete _) -> True
   _ -> m == n
diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs
index f755397f2..5e4d2b165 100644
--- a/src/GF/Infra/ReadFiles.hs
+++ b/src/GF/Infra/ReadFiles.hs
@@ -99,7 +99,7 @@ importsOfFile =
   unComm                     -- ignore comments before the headed line
  where
     term = flip elem ["{",";"]
-    spec = flip elem ["of", "open","in", "reuse", "=", "(", ")",",","**"]
+    spec = flip elem ["of", "open","in", ":", "->", "reuse", "=", "(", ")",",","**"]
     unqual ws = case ws of
       "(":q:ws' -> unqual ws'
       w:ws' -> w:unqual ws'
diff --git a/src/GF/Source/AbsGF.hs b/src/GF/Source/AbsGF.hs
index ce307ee17..0dd825891 100644
--- a/src/GF/Source/AbsGF.hs
+++ b/src/GF/Source/AbsGF.hs
@@ -5,6 +5,7 @@ import Ident --H
 -- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
+
 newtype LString = LString String deriving (Eq,Ord,Show)
 data Grammar =
    Gr [ModDef]
@@ -65,7 +66,7 @@ data TopDef =
  | DefFun [FunDef]
  | DefDef [Def]
  | DefData [DataDef]
- | DefTrans [FlagDef]
+ | DefTrans [Def]
  | DefPar [ParDef]
  | DefOper [Def]
  | DefLincat [PrintDef]
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index a211605fc..73f65c85c 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -20,10 +20,11 @@ trModule (i,mo) = case mo of
                             (map trFlag (flags m))))
  where
    i' = tri i
-   mkModule = case typeOfModule mo of
-     MTResource -> P.MResource
-     MTAbstract -> P.MAbstract
-     MTConcrete a -> P.MConcrete (tri a)
+   mkModule m = case typeOfModule mo of
+     MTResource -> P.MResource m
+     MTAbstract -> P.MAbstract m
+     MTConcrete a -> P.MConcrete m (tri a)
+     MTTransfer a b -> P.MTransfer m (trOpen a) (trOpen b)
 
 trExtend :: Maybe Ident -> P.Extend
 trExtend i = maybe P.NoExt (P.Ext . tri) i
@@ -50,6 +51,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
     _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
   ---- don't destroy definitions!
+  AbsTrans f -> [P.DefTrans [P.DDef [i'] (trt f)]]
 
   ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
   ResParam pp -> [P.DefPar [case pp of
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index fbb5afafa..3024d49db 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -166,7 +166,7 @@ instance Print TopDef where
    DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
    DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
    DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs])
-   DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
+   DefTrans defs -> prPrec i 0 (concat [["transfer"] , prt 0 defs])
    DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
    DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
    DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs])
diff --git a/src/GF/Source/SkelGF.hs b/src/GF/Source/SkelGF.hs
index f18b5bd7b..5f5c16227 100644
--- a/src/GF/Source/SkelGF.hs
+++ b/src/GF/Source/SkelGF.hs
@@ -88,7 +88,7 @@ transTopDef x = case x of
   DefFun fundefs  -> failure x
   DefDef defs  -> failure x
   DefData datadefs  -> failure x
-  DefTrans flagdefs  -> failure x
+  DefTrans defs  -> failure x
   DefPar pardefs  -> failure x
   DefOper defs  -> failure x
   DefLincat printdefs  -> failure x
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index b6c3f3a44..9e016d711 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -150,9 +150,8 @@ transAbsDef x = case x of
       [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
       [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
   DefTrans defs  -> do
-    let (ids,vals) = unzip [(i,v) | FlagDef i v <- defs]
-    defs' <- liftM2 zip (mapM transIdent ids) (mapM transIdent vals)
-    returnl [(c, G.AbsTrans f) | (c,f) <- defs']
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsTrans f) | (c,(_,Yes f)) <- defs']
   DefFlag defs -> liftM Right $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
  where
diff --git a/src/GF/UseGrammar/Transfer.hs b/src/GF/UseGrammar/Transfer.hs
new file mode 100644
index 000000000..2551a039d
--- /dev/null
+++ b/src/GF/UseGrammar/Transfer.hs
@@ -0,0 +1,29 @@
+module Transfer where
+
+import Grammar
+import Values
+import AbsCompute
+import qualified GFC
+import LookAbs
+import MMacros
+import TypeCheck
+
+import Ident
+import Operations
+
+import Monad
+
+-- linearize, parse, etc, by transfer. AR 9/10/2003
+
+doTransfer :: GFC.CanonGrammar -> Ident -> Tree -> Err Tree
+doTransfer gr tra t = do
+  cat <- liftM snd $ val2cat $ valTree t
+  f   <- lookupTransfer gr tra cat
+  e   <- compute gr $ App f $ tree2exp t
+  annotate gr e
+
+useByTransfer :: (Tree -> Err a) -> GFC.CanonGrammar -> Ident -> (Tree -> Err a)
+useByTransfer lin gr tra t = doTransfer gr tra t >>= lin
+
+mkByTransfer :: (a -> Err [Tree]) -> GFC.CanonGrammar -> Ident -> (a -> Err [Tree])
+mkByTransfer parse gr tra s = parse s >>= mapM (doTransfer gr tra)
diff --git a/src/Today.hs b/src/Today.hs
index bf8573337..923866d3b 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Wed Oct  8 11:43:12 CEST 2003"
+module Today where today = "Thu Oct  9 17:52:24 CEST 2003"