GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-01 07:12:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

oper overloading: first implemenatation using records

Browse Source
This commit is contained in:
aarne
2006-11-17 13:40:55 +00:00
parent 4865b1d099
commit 3f30dfd347
6 changed files with 72 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Source/GrammarToSource.hs
View File

@@ -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 ->

8
src/GF/Source/SourceToGrammar.hs
View File

@@ -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