mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
make it possible to override opers defined in an interface by syntax 'instance Foo of Bar - [f,g,h]'
This commit is contained in:
@@ -178,7 +178,7 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
|
|||||||
depModType (MTResource) xs = xs
|
depModType (MTResource) xs = xs
|
||||||
depModType (MTInterface) xs = xs
|
depModType (MTInterface) xs = xs
|
||||||
depModType (MTConcrete m2) xs = modName m2:xs
|
depModType (MTConcrete m2) xs = modName m2:xs
|
||||||
depModType (MTInstance m2) xs = modName m2:xs
|
depModType (MTInstance (m2,_)) xs = modName m2:xs
|
||||||
|
|
||||||
depExtends es xs = foldr depInclude xs es
|
depExtends es xs = foldr depInclude xs es
|
||||||
|
|
||||||
|
|||||||
@@ -89,10 +89,10 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_)) = do
|
|||||||
("module" +++ showIdent i +++
|
("module" +++ showIdent i +++
|
||||||
"has open interfaces and must therefore be declared incomplete")
|
"has open interfaces and must therefore be declared incomplete")
|
||||||
case mt of
|
case mt of
|
||||||
MTInstance i0 -> do
|
MTInstance (i0,mincl) -> do
|
||||||
m1 <- lookupModule gr i0
|
m1 <- lookupModule gr i0
|
||||||
testErr (isModRes m1) ("interface expected instead of" +++ showIdent i0)
|
testErr (isModRes m1) ("interface expected instead of" +++ showIdent i0)
|
||||||
js' <- extendMod gr False (i0,const True) i (jments m1) (jments mi)
|
js' <- extendMod gr False (i0, isInherited mincl) i (jments m1) (jments mi)
|
||||||
--- to avoid double inclusions, in instance I of I0 = J0 ** ...
|
--- to avoid double inclusions, in instance I of I0 = J0 ** ...
|
||||||
case extends mi of
|
case extends mi of
|
||||||
[] -> return $ replaceJudgements mi js'
|
[] -> return $ replaceJudgements mi js'
|
||||||
|
|||||||
@@ -132,11 +132,11 @@ ComplMod
|
|||||||
|
|
||||||
ModType :: { (ModuleType,Ident) }
|
ModType :: { (ModuleType,Ident) }
|
||||||
ModType
|
ModType
|
||||||
: 'abstract' Ident { (MTAbstract, $2) }
|
: 'abstract' Ident { (MTAbstract, $2) }
|
||||||
| 'resource' Ident { (MTResource, $2) }
|
| 'resource' Ident { (MTResource, $2) }
|
||||||
| 'interface' Ident { (MTInterface, $2) }
|
| 'interface' Ident { (MTInterface, $2) }
|
||||||
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
|
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
|
||||||
| 'instance' Ident 'of' Ident { (MTInstance $4, $2) }
|
| 'instance' Ident 'of' Included { (MTInstance $4, $2) }
|
||||||
|
|
||||||
ModHeaderBody :: { ( [(Ident,MInclude)]
|
ModHeaderBody :: { ( [(Ident,MInclude)]
|
||||||
, Maybe (Ident,MInclude,[(Ident,Ident)])
|
, Maybe (Ident,MInclude,[(Ident,Ident)])
|
||||||
|
|||||||
@@ -61,7 +61,7 @@ ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments) =
|
|||||||
MTResource -> text "resource" <+> ppIdent mn
|
MTResource -> text "resource" <+> ppIdent mn
|
||||||
MTConcrete abs -> text "concrete" <+> ppIdent mn <+> text "of" <+> ppIdent abs
|
MTConcrete abs -> text "concrete" <+> ppIdent mn <+> text "of" <+> ppIdent abs
|
||||||
MTInterface -> text "interface" <+> ppIdent mn
|
MTInterface -> text "interface" <+> ppIdent mn
|
||||||
MTInstance int -> text "instance" <+> ppIdent mn <+> text "of" <+> ppIdent int
|
MTInstance ie -> text "instance" <+> ppIdent mn <+> text "of" <+> ppExtends ie
|
||||||
|
|
||||||
ppExtends (id,MIAll ) = ppIdent id
|
ppExtends (id,MIAll ) = ppIdent id
|
||||||
ppExtends (id,MIOnly incs) = ppIdent id <+> brackets (commaPunct ppIdent incs)
|
ppExtends (id,MIOnly incs) = ppIdent id <+> brackets (commaPunct ppIdent incs)
|
||||||
|
|||||||
@@ -58,7 +58,7 @@ grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i]
|
|||||||
modtype = mtype m,
|
modtype = mtype m,
|
||||||
ofs = case mtype m of
|
ofs = case mtype m of
|
||||||
MTConcrete i -> [i | yes i]
|
MTConcrete i -> [i | yes i]
|
||||||
MTInstance i -> [i | yes i]
|
MTInstance (i,_) -> [i | yes i]
|
||||||
_ -> [],
|
_ -> [],
|
||||||
extendeds = nub $ filter yes $ map fst (extend m),
|
extendeds = nub $ filter yes $ map fst (extend m),
|
||||||
openeds = nub $ filter yes $ map openedModule (opens m),
|
openeds = nub $ filter yes $ map openedModule (opens m),
|
||||||
|
|||||||
@@ -74,7 +74,7 @@ data ModuleType =
|
|||||||
| MTConcrete Ident
|
| MTConcrete Ident
|
||||||
-- ^ up to this, also used in GFO. Below, source only.
|
-- ^ up to this, also used in GFO. Below, source only.
|
||||||
| MTInterface
|
| MTInterface
|
||||||
| MTInstance Ident
|
| MTInstance (Ident,MInclude)
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
|
data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
|
||||||
@@ -145,7 +145,7 @@ depPathModule m = fors m ++ exts m ++ opens m
|
|||||||
fors m =
|
fors m =
|
||||||
case mtype m of
|
case mtype m of
|
||||||
MTConcrete i -> [OSimple i]
|
MTConcrete i -> [OSimple i]
|
||||||
MTInstance i -> [OSimple i]
|
MTInstance (i,_) -> [OSimple i]
|
||||||
_ -> []
|
_ -> []
|
||||||
exts m = map OSimple (extends m)
|
exts m = map OSimple (extends m)
|
||||||
|
|
||||||
@@ -189,7 +189,7 @@ allExtendsPlus gr i =
|
|||||||
Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
|
Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
|
||||||
_ -> []
|
_ -> []
|
||||||
where
|
where
|
||||||
exts m = extends m ++ [j | MTInstance j <- [mtype m]]
|
exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
|
||||||
|
|
||||||
-- | conversely: all modules that extend a given module, incl. instances of interface
|
-- | conversely: all modules that extend a given module, incl. instances of interface
|
||||||
allExtensions :: MGrammar a -> Ident -> [Ident]
|
allExtensions :: MGrammar a -> Ident -> [Ident]
|
||||||
@@ -198,9 +198,11 @@ allExtensions gr i =
|
|||||||
Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
|
Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
|
||||||
_ -> []
|
_ -> []
|
||||||
where
|
where
|
||||||
exts i = [j | (j,m) <- mods, elem i (extends m)
|
exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m]
|
||||||
|| elem (MTInstance i) [mtype m]]
|
|
||||||
mods = modules gr
|
mods = modules gr
|
||||||
|
isInstanceOf i m = case mtype m of
|
||||||
|
MTInstance (j,_) -> j == i
|
||||||
|
_ -> False
|
||||||
|
|
||||||
-- | initial search path: the nonqualified dependencies
|
-- | initial search path: the nonqualified dependencies
|
||||||
searchPathModule :: ModInfo a -> [Ident]
|
searchPathModule :: ModInfo a -> [Ident]
|
||||||
|
|||||||
Reference in New Issue
Block a user