From 2ee936c7e23bd690b05b8362179911a2d176f150 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 9 Oct 2003 15:23:32 +0000
Subject: Added treatment of transfer modules. Aggregation is an example.

---
 src/GF/Grammar/LookAbs.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'src/GF/Grammar/LookAbs.hs')

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
-- 
cgit v1.2.3