overload extension: syntax overload OldModule* {def*}

lib/resource-1.4/api/TryEng.gf

@@ -1,3 +1,3 @@
---# -path=.:alltenses:prelude
+--# -path=.:alltenses-1.4:prelude
 
 resource TryEng = SyntaxEng, LexiconEng, ParadigmsEng - [mkAdv] ;

src-3.0/GF/Compile/CheckGrammar.hs

@@ -232,7 +232,10 @@ checkResInfo gr mo mm (c,info) = do
       return (c, ResOper pty' pde')
 
     ResOverload os tysts -> chIn "overloading" $ do
-      tysts' <- mapM (uncurry $ flip check) tysts
+      --tysts' <- mapM (uncurry $ flip check) tysts
+      tysts0 <- checkErr $ lookupOverload gr mo c
+      tysts' <- mapM (uncurry $ flip check) 
+                  [(mkFunType args val,tr) | (args,(val,tr)) <- tysts0]
       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
@@ -256,8 +259,8 @@ checkResInfo gr mo mm (c,info) = do
 
    checkUniq xss = case xss of
      x:y:xs 
-      | x == y -> raise $ "ambiguous for argument list" +++ 
+      | x == y -> raise $ "ambiguous for type" +++ 
-                         unwords (map (prtType gr) x)  
+                           prtType gr (mkFunType (init x) (last x))  
       | otherwise -> checkUniq $ y:xs
      _ -> return ()
 

src-3.0/GF/Compile/Rename.hs

@@ -171,7 +171,7 @@ renameInfo mo status (i,info) = errIn
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
   ResOverload os tysts -> 
-    liftM2 ResOverload (mapM rent os) (mapM (pairM rent) tysts)
+    liftM (ResOverload os) (mapM (pairM rent) tysts)
 
   ResParam (Yes (pp,m)) -> do
     pp' <- mapM (renameParam status) pp

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 [Term] [(Type,Term)]        -- ^ (/RES/)
+ | ResOverload [Ident] [(Type,Term)]       -- ^ (/RES/) idents: modules inherited
 
 -- judgements in concrete syntax
  | CncCat  (Perh Type) (Perh Term) MPr     -- ^ (/CNC/) lindef ini'zed, 

src-3.0/GF/Grammar/Lookup.hs

@@ -116,9 +116,11 @@ lookupOverload gr m c = do
       ModMod mo -> do
         info <- lookupIdentInfo mo c
         case info of
-          ResOverload os tysts -> 
+          ResOverload os tysts -> do
-            return [(map snd args,(val,tr)) | 
+            tss <- mapM (\x -> lookupOverload gr x c) os
-                      (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]]
+            return $ [(map snd args,(val,tr)) | 
+                      (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]] ++ 
+                     concat tss
 
           AnyInd _ n  -> lookupOverload gr n c
           _   -> Bad $ prt c +++ "is not an overloaded operation"

src-3.0/GF/Source/GrammarToSource.hs

@@ -100,7 +100,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
     [P.DefOper [P.DDef [mkName i'] (
       foldl P.EApp 
         (P.EIdent $ tri $ cOverload)
-          (map trt os ++ 
+          (map (P.EIdent . tri) os ++ 
            [P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]]))]]
 
   CncCat (Yes ty) Nope _ -> 

src-3.0/GF/Source/SourceToGrammar.hs

@@ -357,7 +357,7 @@ transResDef x = case x 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])]
+           [(c,p,G.ResOverload [m | G.Vr m <- ts] [(ty,fu) | (_,(Just ty,fu)) <- fs])]
          _ -> [op]
        _ -> [op]