Added treatment of transfer modules. Aggregation is an example.

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
+

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])

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