GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-30 06:52:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

extended functor syntax

Browse Source
This commit is contained in:
aarne
2007-06-19 18:12:35 +00:00
parent 2ded5b6d28
commit 219c686633
9 changed files with 631 additions and 579 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -92,32 +92,40 @@ transModDef x = case x of
open' <- transIdent open
mkModRes id (GM.MTInstance open') body
case body of
MBody extends opens defs -> do
mkBody (mstat', trDef, mtyp', id') body
where
mkBody xx@(mstat', trDef, mtyp', id') bod = case bod of
MNoBody incls -> do
mkBody xx $ MBody (Ext incls) NoOpens []
MBody extends opens defs -> do
extends' <- transExtend extends
opens' <- transOpens opens
defs0 <- mapM trDef $ getTopDefs defs
defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
flags' <- return [f | Right fs <- defs0, f <- fs]
return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
MReuse _ -> do
MReuse _ -> do
return (id', GM.ModMod (GM.Module mtyp' mstat' [] [] [] emptyBinTree))
MUnion imps -> do
MUnion imps -> do
imps' <- mapM transIncluded imps
return (id',
GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] [] [] emptyBinTree))
MWith m opens -> do
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' [] opens')
MWithE extends m opens -> do
MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
MWithE extends m insts -> mkBody xx $ MWithEBody extends m insts NoOpens []
MWithEBody extends m insts opens defs -> do
extends' <- mapM transIncludedExt extends
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' extends' opens')
where
mkModRes id mtyp body = do
m' <- transIncludedExt m
insts' <- mapM transOpen insts
opens' <- transOpens opens
defs0 <- mapM trDef $ getTopDefs defs
defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
flags' <- return [f | Right fs <- defs0, f <- fs]
return (id',
GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs') m' insts')
mkModRes id mtyp body = do
id' <- transIdent id
case body of
MReuse c -> do
@@ -125,7 +133,7 @@ transModDef x = case x of
mtyp' <- trMReuseType mtyp c'
return (transResDef, GM.MTReuse mtyp', id')
_ -> return (transResDef, mtyp, id')
trMReuseType mtyp c = case mtyp of
trMReuseType mtyp c = case mtyp of
GM.MTInterface -> return $ GM.MRInterface c
GM.MTInstance op -> return $ GM.MRInstance c op
GM.MTResource -> return $ GM.MRResource c
@@ -715,4 +723,4 @@ mkConsId = prefixId "Cons"
mkBaseId = prefixId "Base"
prefixId :: String -> Ident -> Ident
prefixId pref id = IC (pref ++ prIdent id)
prefixId pref id = IC (pref ++ prIdent id)