oper overloading: first implemenatation using records

2 files changed, 17 insertions, 0 deletions

diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index f49075f48..40f18bd35 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -92,6 +92,8 @@ data Info =
  | ResValue (Perh (Type,Maybe Int))        -- ^ (/RES/) to mark parameter constructors for lookup
  | ResOper  (Perh Type) (Perh Term)        -- ^ (/RES/)
 
+ | ResOverload [(Type,Term)]               -- ^ (/RES/)
+
 -- judgements in concrete syntax
  | CncCat  (Perh Type) (Perh Term) MPr     -- ^ (/CNC/) lindef ini'zed, 
  | CncFun  (Maybe (Ident,(Context,Type))) (Perh Term) MPr  -- (/CNC/) type info added at 'TC'
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index 9f360dfcd..a0d0d1cea 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -18,6 +18,7 @@ module GF.Grammar.Lookup (
                lookupResDef,
                lookupResDefKind,
 	       lookupResType, 
+               lookupOverload,
 	       lookupParams, 
 	       lookupParamValues, 
 	       lookupFirstTag, 
@@ -105,6 +106,20 @@ lookupResType gr m c = do
             AnyInd _ n -> lookFun e m c n
             _ -> prtBad "cannot find type of reused function" c
 
+lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))]
+lookupOverload gr m c = do
+    mi   <- lookupModule gr m
+    case mi of
+      ModMod mo -> do
+        info <- lookupIdentInfo mo c
+        case info of
+          ResOverload tysts -> 
+            return [(map snd args,(val,tr)) | 
+                      (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]]
+
+          AnyInd _ n  -> lookupOverload gr n c
+          _   -> Bad $ prt c +++ "is not an overloaded operation"
+      _ -> Bad $ prt m +++ "is not a resource"
 
 lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe PValues)
 lookupParams gr = look True where