added an argument place to ResOverload for extended overloads

7 files changed, 30 insertions, 19 deletions

diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
index fe4b7223c..2fb4f5895 100644
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ b/src-3.0/GF/Compile/CheckGrammar.hs
@@ -231,14 +231,14 @@ checkResInfo gr mo mm (c,info) = do
          _ -> return (pty, pde) --- other cases are uninteresting
       return (c, ResOper pty' pde')
 
-    ResOverload tysts -> chIn "overloading" $ do
+    ResOverload os tysts -> chIn "overloading" $ do
       tysts' <- mapM (uncurry $ flip check) tysts
       let tysts2 = [(y,x) | (x,y) <- tysts']
       --- this can only be a partial guarantee, since matching
       --- with value type is only possible if expected type is given
       checkUniq $ 
         sort [t : map snd xs | (x,_) <- tysts2, Ok (xs,t) <- [typeFormCnc x]]
-      return (c,ResOverload tysts2)
+      return (c,ResOverload os tysts2)
 
     ResParam (Yes (pcs,_)) -> chIn "parameter type" $ do
 ----      mapM ((mapM (computeLType gr . snd)) . snd) pcs
diff --git a/src-3.0/GF/Compile/Refresh.hs b/src-3.0/GF/Compile/Refresh.hs
index 09c384266..39fb57db0 100644
--- a/src-3.0/GF/Compile/Refresh.hs
+++ b/src-3.0/GF/Compile/Refresh.hs
@@ -119,10 +119,10 @@ refreshModule (k,ms) mi@(i,m) = case m of
     ResOper ptyp (Yes trm) -> do   ---- refresh ptyp
       (k',trm') <- refreshTermKN k trm
       return $ (k', (c, ResOper ptyp (Yes trm')):cs)
-    ResOverload tyts -> do
+    ResOverload os tyts -> do
       (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ 
                     appSTM (mapPairsM refresh tyts) (initIdStateN k)
-      return $ (k', (c, ResOverload tyts'):cs)
+      return $ (k', (c, ResOverload os tyts'):cs)
     CncCat mt (Yes trm) pn -> do   ---- refresh mt, pn
       (k',trm') <- refreshTermKN k trm
       return $ (k', (c, CncCat mt (Yes trm') pn):cs)
diff --git a/src-3.0/GF/Compile/Rename.hs b/src-3.0/GF/Compile/Rename.hs
index 28055b85e..14c25c32b 100644
--- a/src-3.0/GF/Compile/Rename.hs
+++ b/src-3.0/GF/Compile/Rename.hs
@@ -170,7 +170,8 @@ renameInfo mo status (i,info) = errIn
   AbsTrans f -> liftM AbsTrans (rent f)
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
-  ResOverload tysts -> liftM ResOverload $ mapM (pairM rent) tysts
+  ResOverload os tysts -> 
+    liftM2 ResOverload (mapM rent os) (mapM (pairM rent) tysts)
 
   ResParam (Yes (pp,m)) -> do
     pp' <- mapM (renameParam status) pp
diff --git a/src-3.0/GF/Grammar/Grammar.hs b/src-3.0/GF/Grammar/Grammar.hs
index 9771a56dd..d16c6d381 100644
--- a/src-3.0/GF/Grammar/Grammar.hs
+++ b/src-3.0/GF/Grammar/Grammar.hs
@@ -98,7 +98,7 @@ data Info =
  | ResValue (Perh (Type,Maybe Int))        -- ^ (/RES/) to mark parameter constructors for lookup
  | ResOper  (Perh Type) (Perh Term)        -- ^ (/RES/)
 
- | ResOverload [(Type,Term)]               -- ^ (/RES/)
+ | ResOverload [Term] [(Type,Term)]        -- ^ (/RES/)
 
 -- judgements in concrete syntax
  | CncCat  (Perh Type) (Perh Term) MPr     -- ^ (/CNC/) lindef ini'zed, 
diff --git a/src-3.0/GF/Grammar/Lookup.hs b/src-3.0/GF/Grammar/Lookup.hs
index 35e3b8006..36cd2101c 100644
--- a/src-3.0/GF/Grammar/Lookup.hs
+++ b/src-3.0/GF/Grammar/Lookup.hs
@@ -116,7 +116,7 @@ lookupOverload gr m c = do
       ModMod mo -> do
         info <- lookupIdentInfo mo c
         case info of
-          ResOverload tysts -> 
+          ResOverload os tysts -> 
             return [(map snd args,(val,tr)) | 
                       (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]]
 
diff --git a/src-3.0/GF/Source/GrammarToSource.hs b/src-3.0/GF/Source/GrammarToSource.hs
index 75446a6e4..e00edc689 100644
--- a/src-3.0/GF/Source/GrammarToSource.hs
+++ b/src-3.0/GF/Source/GrammarToSource.hs
@@ -96,10 +96,12 @@ trAnyDef (i,info) = let i' = tri i in case info of
     May b  -> P.ParDefIndir i' $ tri b
     _      -> P.ParDefAbs i']]
 
-  ResOverload tysts -> 
+  ResOverload os tysts -> 
     [P.DefOper [P.DDef [mkName i'] (
-      P.EApp (P.EIdent $ tri $ cOverload)
-        (P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
+      foldl P.EApp 
+        (P.EIdent $ tri $ cOverload)
+          (map trt os ++ 
+           [P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]]))]]
 
   CncCat (Yes ty) Nope _ -> 
     [P.DefLincat [P.PrintDef [mkName i'] (trt ty)]] 
diff --git a/src-3.0/GF/Source/SourceToGrammar.hs b/src-3.0/GF/Source/SourceToGrammar.hs
index 74b168b46..0e0d790c1 100644
--- a/src-3.0/GF/Source/SourceToGrammar.hs
+++ b/src-3.0/GF/Source/SourceToGrammar.hs
@@ -353,18 +353,26 @@ transResDef x = case x of
   DefFlag defs -> liftM (Right . concatModuleOptions) $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition form in resource" +++ printTree x
  where
-   mkOverload (c,p,j) = case j of
-     G.ResOper _ (Yes (G.App keyw (G.R fs@(_:_:_)))) | 
-                                          isOverloading keyw c fs -> 
-       [(c,p,G.ResOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
+   mkOverload op@(c,p,j) = case j of
+     G.ResOper _ (Yes df) -> case M.appForm df of
+       (keyw, ts@(_:_)) | isOverloading keyw -> case last ts of
+         G.R fs -> 
+           [(c,p,G.ResOverload (init ts) [(ty,fu) | (_,(Just ty,fu)) <- fs])]
+         _ -> [op]
+       _ -> [op]
 
      -- to enable separare type signature --- not type-checked
-     G.ResOper (Yes (G.App keyw (G.RecType fs@(_:_:_)))) _ | 
-                                          isOverloading keyw c fs -> []
+     G.ResOper (Yes df) _ -> case M.appForm df of
+       (keyw, ts@(_:_)) | isOverloading keyw -> case last ts of
+         G.RecType _ -> [] 
+         _ -> [op]
+       _ -> [op]
      _ -> [(c,p,j)]
-   isOverloading keyw c fs = 
-     GP.prt keyw == "overload" &&       -- overload is a "soft keyword"
-     all (== GP.prt c) (map (GP.prt . fst) fs)
+   isOverloading keyw = 
+     GP.prt keyw == "overload"       -- overload is a "soft keyword"
+   isRec t = case t of
+     G.R _ -> True
+     _ -> False
 
 transParDef :: ParDef -> Err (Ident, [G.Param])
 transParDef x = case x of