From 580f7d79952836068686d73bcc70fc9df5562e13 Mon Sep 17 00:00:00 2001 From: aarne Date: Fri, 17 Nov 2006 13:40:55 +0000 Subject: oper overloading: first implemenatation using records --- src/GF/Source/GrammarToSource.hs | 4 ++++ src/GF/Source/SourceToGrammar.hs | 8 +++++++- 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'src/GF/Source') diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs index a20eb7830..055c79d15 100644 --- a/src/GF/Source/GrammarToSource.hs +++ b/src/GF/Source/GrammarToSource.hs @@ -94,6 +94,10 @@ trAnyDef (i,info) = let i' = tri i in case info of May b -> P.ParDefIndir i' $ tri b _ -> P.ParDefAbs i']] + ResOverload tysts -> + [P.DefOper [P.DDef [mkName i'] ( + P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts])]] + CncCat (Yes ty) Nope _ -> [P.DefLincat [P.PrintDef [mkName i'] (trt ty)]] CncCat pty ptr ppr -> diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs index dadf8c3af..49023bf09 100644 --- a/src/GF/Source/SourceToGrammar.hs +++ b/src/GF/Source/SourceToGrammar.hs @@ -299,7 +299,7 @@ transResDef x = case x of (p,pars) <- pardefs', (f,co) <- pars] DefOper defs -> do defs' <- liftM concat $ mapM getDefs defs - returnl [(f, G.ResOper pt pe) | (f,(pt,pe)) <- defs'] + returnl [mkOverload (f, G.ResOper pt pe) | (f,(pt,pe)) <- defs'] DefLintype defs -> do defs' <- liftM concat $ mapM getDefs defs @@ -307,6 +307,12 @@ transResDef x = case x of DefFlag defs -> liftM Right $ mapM transFlagDef defs _ -> Bad $ "illegal definition form in resource" +++ printTree x + where + mkOverload (c,j) = case j of + G.ResOper Nope (Yes (G.R fs@(_:_:_))) | isOverloading c fs -> + (c,G.ResOverload [(ty,fu) | (_,(Just ty,fu)) <- fs]) + _ -> (c,j) + isOverloading c fs = all (== GP.prt c) (map (GP.prt . fst) fs) transParDef :: ParDef -> Err (Ident, [G.Param]) transParDef x = case x of -- cgit v1.2.3