forked from GitHub/gf-core
restored interface and instance - at least for a while
This commit is contained in:
@@ -53,7 +53,7 @@ extendModule gf nmo0 = do
|
||||
m <- lookupModule gf n
|
||||
|
||||
-- test that the module types match, and find out if the old is complete
|
||||
testErr (mtype mo == mtype m)
|
||||
testErr True ---- (mtype mo == mtype m)
|
||||
("illegal extension type to module" +++ prt name)
|
||||
return (m, isCompleteModule m)
|
||||
|
||||
@@ -103,10 +103,10 @@ tryInsert unif indir tree z@(x, info) = case Data.Map.lookup x tree of
|
||||
-- AR 24/10/2003
|
||||
rebuildModule :: GF -> SourceModule -> Err SourceModule
|
||||
rebuildModule gr mo@(i,mi) = case mtype mi of
|
||||
MTConcrete i0 -> do
|
||||
MTInstance i0 -> do
|
||||
m1 <- lookupModule gr i0
|
||||
testErr (mtype m1 == MTAbstract)
|
||||
("abstract expected as type of" +++ prt i0)
|
||||
testErr (mtype m1 == MTInterface)
|
||||
("interface expected as type of" +++ prt i0)
|
||||
js' <- extendMod False i0 (const True) i (mjments m1) (mjments mi)
|
||||
--- to avoid double inclusions, in instance I of I0 = J0 ** ...
|
||||
case mextends mi of
|
||||
|
||||
@@ -38,6 +38,8 @@ trModule (i,mo) = P.MModule compl typ body where
|
||||
MTGrammar -> P.MGrammar i'
|
||||
MTAbstract -> P.MAbstract i'
|
||||
MTConcrete a -> P.MConcrete i' (tri a)
|
||||
MTInterface -> P.MInterface i'
|
||||
MTInstance a -> P.MInstance i' (tri a)
|
||||
body = P.MBody
|
||||
(trExtends (mextends mo))
|
||||
(mkOpens (map trOpen (mopens mo)))
|
||||
|
||||
@@ -54,6 +54,8 @@ type JEntry = Either Judgement Indirection
|
||||
data ModuleType =
|
||||
MTAbstract
|
||||
| MTConcrete Ident
|
||||
| MTInterface
|
||||
| MTInstance Ident
|
||||
| MTGrammar
|
||||
deriving Eq
|
||||
|
||||
|
||||
@@ -85,10 +85,10 @@ transModDef x = case x of
|
||||
id' <- transIdent id
|
||||
open' <- transIdent open
|
||||
return (transCncDef, MTConcrete open', id')
|
||||
MInterface id -> mkModRes id MTAbstract body
|
||||
MInterface id -> mkModRes id MTInterface body
|
||||
MInstance id open -> do
|
||||
open' <- transIdent open
|
||||
mkModRes id (MTConcrete open') body
|
||||
mkModRes id (MTInstance open') body
|
||||
|
||||
mkBody (trDef, mtyp', id') body
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user