added an argument place to ResOverload for extended overloads

This commit is contained in:
aarne
2008-06-01 11:02:02 +00:00
parent b54c5ddb7c
commit 07c8a4383a
7 changed files with 30 additions and 19 deletions

View File

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

View File

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