summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
authoraarne <unknown>2003-11-05 14:42:29 +0000
committeraarne <unknown>2003-11-05 14:42:29 +0000
commit49c17be41a7d572d27df74eb7351b672e85953a1 (patch)
tree2856b2b2af3c3d6adea285dcb42173b920751897 /src/GF/Compile
parented1d2a2954a3c955625cf210905a67e0683c8411 (diff)
working with interfaces
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/Compile.hs5
-rw-r--r--src/GF/Compile/Extend.hs1
-rw-r--r--src/GF/Compile/ModDeps.hs4
-rw-r--r--src/GF/Compile/Rebuild.hs21
-rw-r--r--src/GF/Compile/Rename.hs6
5 files changed, 23 insertions, 14 deletions
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index a1b1758fb..edd75ef6b 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -186,18 +186,19 @@ generateModuleCode opts path minfo@(name,info) = do
-- for resource, also emit gfr
case info of
- ModMod m | isResourceModule info && isCompilableModule info && emit && nomulti -> do
+ ModMod m | isResourceModule info && isCompilable info && emit && nomulti -> do
let (file,out) = (gfrFile pname, prGrammar (MGrammar [minfo]))
ioeIO $ writeFile file out >> putStr (" wrote file" +++ file)
_ -> return ()
(file,out) <- do
code <- return $ MkGFC.prCanonModInfo minfo'
return (gfcFile pname, code)
- if isCompilableModule info && emit && nomulti
+ if isCompilable info && emit && nomulti
then ioeIO $ writeFile file out >> putStr (" wrote file" +++ file)
else ioeIO $ putStrFlush "no need to save for this module "
return minfo'
where
+ isCompilable _ = True ---- isCompilableModule ---- emit code for interfaces
nomulti = not $ oElem makeMulti opts
emit = oElem emitCode opts
optim = oElem optimizeCanon opts
diff --git a/src/GF/Compile/Extend.hs b/src/GF/Compile/Extend.hs
index 5c70a1141..c0c46f956 100644
--- a/src/GF/Compile/Extend.hs
+++ b/src/GF/Compile/Extend.hs
@@ -15,6 +15,7 @@ import Monad
-- The top-level function $extendModInfo$
-- extends a module symbol table by indirections to the module it extends
+--- this is not in use 5/11/2003
extendModInfo :: Ident -> SourceModInfo -> SourceModInfo -> Err SourceModInfo
extendModInfo name old new = case (old,new) of
(ModMod m0, ModMod (Module mt st fs _ ops js)) -> do
diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs
index 93c2e6781..2f5f916d6 100644
--- a/src/GF/Compile/ModDeps.hs
+++ b/src/GF/Compile/ModDeps.hs
@@ -82,7 +82,9 @@ moduleDeps ms = mapM deps ms where
(MTConcrete _, MTConcrete _) -> True
(MTInstance _, MTInstance _) -> True
(MTReuse _, MTReuse _) -> True
- ---- some more
+ (MTInstance _, MTResource) -> True
+ (MTResource, MTInstance _) -> True
+ ---- some more?
_ -> mt0 == mt
-- in the same way; this defines what can be opened
compatOType mt0 mt = case mt0 of
diff --git a/src/GF/Compile/Rebuild.hs b/src/GF/Compile/Rebuild.hs
index 6bb25ed7f..5a551ea6c 100644
--- a/src/GF/Compile/Rebuild.hs
+++ b/src/GF/Compile/Rebuild.hs
@@ -11,7 +11,8 @@ import Ident
import Modules
import Operations
--- rebuilding instance + interface, and "with" modules, prior to renaming. AR 24/10/2003
+-- rebuilding instance + interface, and "with" modules, prior to renaming.
+-- AR 24/10/2003
rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
rebuildModule ms mo@(i,mi) = do
@@ -28,7 +29,7 @@ rebuildModule ms mo@(i,mi) = do
MTInstance i0 -> do
m0 <- lookupModule gr i0
m' <- case m0 of
- ModMod m1 | mtype m1 == MTInterface -> do
+ ModMod m1 | isResourceModule m0 -> do ---- mtype m1 == MTInterface -> do
---- checkCompleteInstance m1 m -- do this later, in CheckGrammar
js' <- extendMod i (jments m1) (jments m)
return $ replaceJudgements m js'
@@ -41,7 +42,8 @@ rebuildModule ms mo@(i,mi) = do
ModWith mt stat ext ops -> do
let insts = [(inf,inst) |OQualif _ inf inst <- ops]
let infs = map fst insts
- let stat' = ifNull MSComplete (const MSIncomplete) [i | i <- is, notElem i infs]
+ let stat' = ifNull MSComplete (const MSIncomplete)
+ [i | i <- is, notElem i infs]
testErr (stat' == MSComplete || stat == MSIncomplete)
("module" +++ prt i +++ "remains incomplete")
Module mt0 stat0 fs me ops0 js <- do
@@ -52,7 +54,8 @@ rebuildModule ms mo@(i,mi) = do
let ops1 = ops ++ [o | o <- ops0, notElem (openedModule o) infs]
++ [oQualif i i | i <- map snd insts] ----
--- check if me is incomplete
- return $ ModMod $ Module mt0 stat' fs me ops1 (mapTree (qualifInstanceInfo insts) js)
+ return $ ModMod $ Module mt0 stat' fs me ops1
+ (mapTree (qualifInstanceInfo insts) js)
_ -> return mi
return (i,mi')
@@ -75,8 +78,8 @@ qualifInstanceInfo insts (c,i) = (c,qualInfo i) where
qualInfo i = case i of
ResOper pty pt -> ResOper (qualP pty) (qualP pt)
CncCat pty pt pp -> CncCat (qualP pty) (qualP pt) (qualP pp)
- CncFun mp pt pp -> CncFun mp (qualP pt) (qualP pp) ---- mp
- ----- ResParam (Yes ps) -> ResParam (yes (map qualParam ps))
+ CncFun mp pt pp -> CncFun (qualLin mp) (qualP pt) (qualP pp) ---- mp
+ ResParam (Yes ps) -> ResParam (yes (map qualParam ps))
ResValue pty -> ResValue (qualP pty)
_ -> i
qualP pt = case pt of
@@ -88,7 +91,9 @@ qualifInstanceInfo insts (c,i) = (c,qualInfo i) where
Q m c -> Q (qualId m) c
QC m c -> QC (qualId m) c
_ -> composSafeOp qual t
-
- -- NB constructor patterns never appear in interfaces so we need not rename them
+ qualParam (p,co) = (p,[(x,qual t) | (x,t) <- co])
+ qualLin (Just (c,(co,t))) = (Just (c,([(x,qual t) | (x,t) <- co], qual t)))
+ qualLin Nothing = Nothing
+ -- NB constructor patterns never appear in interfaces so we need not rename them
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 393f48a9c..120286d4d 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -121,12 +121,12 @@ buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
buildStatus gr c mo = let mo' = self2status c mo in case mo of
ModMod m -> do
let gr1 = MGrammar $ (c,mo) : modules gr
- ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m
+ ops = [OSimple OQNormal e | e <- allExtendsPlus gr1 c] ++ allOpens m
mods <- mapM (lookupModule gr1 . openedModule) ops
let sts = map modInfo2status $ zip ops mods
return $ if isModCnc m
- then (NT, sts) -- the module itself does not define any names
- else (mo',sts) -- so the empty ident is not needed
+ then (NT, reverse sts) -- the module itself does not define any names
+ else (mo',reverse sts) -- so the empty ident is not needed
modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree)
modInfo2status (o,i) = (o,case i of