GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-05 09:12:51 -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 f30fa0b4d1
commit e3f1210369
9 changed files with 631 additions and 579 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/GF/Source/AbsGF.hs
View File

@@ -38,9 +38,12 @@ data ModType =
deriving (Eq,Ord,Show)
data ModBody =
MBody Extend Opens [TopDef]
| MWith Ident [Open]
| MWithE [Included] Ident [Open]
MNoBody [Included]
| MWithBody Included [Open] Opens [TopDef]
| MWithEBody [Included] Included [Open] Opens [TopDef]
| MBody Extend Opens [TopDef]
| MWith Included [Open]
| MWithE [Included] Included [Open]
| MReuse Ident
| MUnion [Included]
deriving (Eq,Ord,Show)

11
src/GF/Source/GF.cf
View File

@@ -43,9 +43,14 @@ MTConcrete. ModType ::= "concrete" Ident "of" Ident ;
MTInstance. ModType ::= "instance" Ident "of" Ident ;
MTTransfer. ModType ::= "transfer" Ident ":" Open "->" Open ;
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
MWith. ModBody ::= Ident "with" [Open] ;
MWithE. ModBody ::= [Included] "**" Ident "with" [Open] ;
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
MNoBody. ModBody ::= [Included] ;
MWith. ModBody ::= Included "with" [Open] ;
MWithBody. ModBody ::= Included "with" [Open] "**" Opens "{" [TopDef] "}" ;
MWithE. ModBody ::= [Included] "**" Included "with" [Open] ;
MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ;
MReuse. ModBody ::= "reuse" Ident ; --%
MUnion. ModBody ::= "union" [Included] ;--%

1104
src/GF/Source/ParGF.hs
View File

File diff suppressed because one or more lines are too long

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

@@ -144,13 +144,15 @@ instance Print ModType where
instance Print ModBody where
prt i e = case e of
MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWith id opens -> prPrec i 0 (concatD [prt 0 id , doc (showString "with") , prt 0 opens])
MWithE includeds id opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 id , doc (showString "with") , prt 0 opens])
MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
instance Print Extend where
prt i e = case e of
Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])

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)