diff options
| -rw-r--r-- | src-3.0/GF/Compile/CheckGrammar.hs | 9 | ||||
| -rw-r--r-- | src-3.0/GF/Compile/Rename.hs | 2 | ||||
| -rw-r--r-- | src-3.0/GF/Grammar/Grammar.hs | 2 | ||||
| -rw-r--r-- | src-3.0/GF/Grammar/Lookup.hs | 8 | ||||
| -rw-r--r-- | src-3.0/GF/Source/GrammarToSource.hs | 2 | ||||
| -rw-r--r-- | src-3.0/GF/Source/SourceToGrammar.hs | 2 |
6 files changed, 15 insertions, 10 deletions
diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs index 2fb4f5895..c580149dc 100644 --- a/src-3.0/GF/Compile/CheckGrammar.hs +++ b/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" +++ - unwords (map (prtType gr) x) + | x == y -> raise $ "ambiguous for type" +++ + prtType gr (mkFunType (init x) (last x)) | otherwise -> checkUniq $ y:xs _ -> return () diff --git a/src-3.0/GF/Compile/Rename.hs b/src-3.0/GF/Compile/Rename.hs index 14c25c32b..7b4d09277 100644 --- a/src-3.0/GF/Compile/Rename.hs +++ b/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 diff --git a/src-3.0/GF/Grammar/Grammar.hs b/src-3.0/GF/Grammar/Grammar.hs index d16c6d381..4210358f1 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 [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, diff --git a/src-3.0/GF/Grammar/Lookup.hs b/src-3.0/GF/Grammar/Lookup.hs index 36cd2101c..c8c07069b 100644 --- a/src-3.0/GF/Grammar/Lookup.hs +++ b/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 -> - return [(map snd args,(val,tr)) | - (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]] + ResOverload os tysts -> do + tss <- mapM (\x -> lookupOverload gr x c) os + 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" diff --git a/src-3.0/GF/Source/GrammarToSource.hs b/src-3.0/GF/Source/GrammarToSource.hs index e00edc689..f76fe6cee 100644 --- a/src-3.0/GF/Source/GrammarToSource.hs +++ b/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 _ -> diff --git a/src-3.0/GF/Source/SourceToGrammar.hs b/src-3.0/GF/Source/SourceToGrammar.hs index 0e0d790c1..5f785f05c 100644 --- a/src-3.0/GF/Source/SourceToGrammar.hs +++ b/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] |