From afbfbaa73a22cf8c4bd56d34b80128d223444e2b Mon Sep 17 00:00:00 2001 From: aarne Date: Sat, 12 Mar 2011 11:24:14 +0000 Subject: [PATCH] make it possible to override opers defined in an interface by syntax 'instance Foo of Bar - [f,g,h]' --- src/compiler/GF/Compile/ReadFiles.hs | 2 +- src/compiler/GF/Compile/Update.hs | 4 ++-- src/compiler/GF/Grammar/Parser.y | 10 +++++----- src/compiler/GF/Grammar/Printer.hs | 2 +- src/compiler/GF/Infra/Dependencies.hs | 2 +- src/compiler/GF/Infra/Modules.hs | 12 +++++++----- 6 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs index 83f99ec17..68f16a5d8 100644 --- a/src/compiler/GF/Compile/ReadFiles.hs +++ b/src/compiler/GF/Compile/ReadFiles.hs @@ -178,7 +178,7 @@ importsOfModule (m,mi) = (modName m,depModInfo mi []) depModType (MTResource) xs = xs depModType (MTInterface) xs = 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 diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs index b5f301e8b..1dcae722c 100644 --- a/src/compiler/GF/Compile/Update.hs +++ b/src/compiler/GF/Compile/Update.hs @@ -89,10 +89,10 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_)) = do ("module" +++ showIdent i +++ "has open interfaces and must therefore be declared incomplete") case mt of - MTInstance i0 -> do + MTInstance (i0,mincl) -> do m1 <- lookupModule gr 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 ** ... case extends mi of [] -> return $ replaceJudgements mi js' diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y index 71b81e345..969aa25c3 100644 --- a/src/compiler/GF/Grammar/Parser.y +++ b/src/compiler/GF/Grammar/Parser.y @@ -132,11 +132,11 @@ ComplMod ModType :: { (ModuleType,Ident) } ModType - : 'abstract' Ident { (MTAbstract, $2) } - | 'resource' Ident { (MTResource, $2) } - | 'interface' Ident { (MTInterface, $2) } - | 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) } - | 'instance' Ident 'of' Ident { (MTInstance $4, $2) } + : 'abstract' Ident { (MTAbstract, $2) } + | 'resource' Ident { (MTResource, $2) } + | 'interface' Ident { (MTInterface, $2) } + | 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) } + | 'instance' Ident 'of' Included { (MTInstance $4, $2) } ModHeaderBody :: { ( [(Ident,MInclude)] , Maybe (Ident,MInclude,[(Ident,Ident)]) diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index ee9cd703b..3319f86e8 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/src/compiler/GF/Grammar/Printer.hs @@ -61,7 +61,7 @@ ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments) = MTResource -> text "resource" <+> ppIdent mn MTConcrete abs -> text "concrete" <+> ppIdent mn <+> text "of" <+> ppIdent abs 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,MIOnly incs) = ppIdent id <+> brackets (commaPunct ppIdent incs) diff --git a/src/compiler/GF/Infra/Dependencies.hs b/src/compiler/GF/Infra/Dependencies.hs index 82606a865..393d0e8c8 100644 --- a/src/compiler/GF/Infra/Dependencies.hs +++ b/src/compiler/GF/Infra/Dependencies.hs @@ -58,7 +58,7 @@ grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i] modtype = mtype m, ofs = case mtype m of MTConcrete i -> [i | yes i] - MTInstance i -> [i | yes i] + MTInstance (i,_) -> [i | yes i] _ -> [], extendeds = nub $ filter yes $ map fst (extend m), openeds = nub $ filter yes $ map openedModule (opens m), diff --git a/src/compiler/GF/Infra/Modules.hs b/src/compiler/GF/Infra/Modules.hs index af930f881..5175dfdd5 100644 --- a/src/compiler/GF/Infra/Modules.hs +++ b/src/compiler/GF/Infra/Modules.hs @@ -74,7 +74,7 @@ data ModuleType = | MTConcrete Ident -- ^ up to this, also used in GFO. Below, source only. | MTInterface - | MTInstance Ident + | MTInstance (Ident,MInclude) deriving (Eq,Show) data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident] @@ -145,7 +145,7 @@ depPathModule m = fors m ++ exts m ++ opens m fors m = case mtype m of MTConcrete i -> [OSimple i] - MTInstance i -> [OSimple i] + MTInstance (i,_) -> [OSimple i] _ -> [] exts m = map OSimple (extends m) @@ -189,7 +189,7 @@ allExtendsPlus gr i = Ok m -> i : concatMap (allExtendsPlus gr) (exts m) _ -> [] 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 allExtensions :: MGrammar a -> Ident -> [Ident] @@ -198,9 +198,11 @@ allExtensions gr i = Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es _ -> [] where - exts i = [j | (j,m) <- mods, elem i (extends m) - || elem (MTInstance i) [mtype m]] + exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m] mods = modules gr + isInstanceOf i m = case mtype m of + MTInstance (j,_) -> j == i + _ -> False -- | initial search path: the nonqualified dependencies searchPathModule :: ModInfo a -> [Ident]