diff options
| author | aarne <unknown> | 2003-11-05 14:42:29 +0000 |
|---|---|---|
| committer | aarne <unknown> | 2003-11-05 14:42:29 +0000 |
| commit | 49c17be41a7d572d27df74eb7351b672e85953a1 (patch) | |
| tree | 2856b2b2af3c3d6adea285dcb42173b920751897 /src/GF/Compile | |
| parent | ed1d2a2954a3c955625cf210905a67e0683c8411 (diff) | |
working with interfaces
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/Compile.hs | 5 | ||||
| -rw-r--r-- | src/GF/Compile/Extend.hs | 1 | ||||
| -rw-r--r-- | src/GF/Compile/ModDeps.hs | 4 | ||||
| -rw-r--r-- | src/GF/Compile/Rebuild.hs | 21 | ||||
| -rw-r--r-- | src/GF/Compile/Rename.hs | 6 |
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 |
