Working with interfaces.

Working with interfaces.
Created new place for grammar parsers.
Created new script jgf2+.
This commit is contained in:
aarne
2003-11-11 15:44:24 +00:00
parent 9b47b4aa12
commit 54c72f5ab0
18 changed files with 5178 additions and 138 deletions

View File

@@ -33,39 +33,13 @@ renameSourceTerm g m t = do
renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
ModMod (Module mt st fs me ops js) -> do
(_,mod1@(ModMod m)) <- extendModule ms (name,mod)
ModMod m@(Module mt st fs me ops js) -> do
let js1 = jments m
status <- buildStatus (MGrammar ms) name mod1
status <- buildStatus (MGrammar ms) name mod
js2 <- mapMTree (renameInfo status) js1
let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
return $ (name,mod2) : ms
extendModule :: [SourceModule] -> SourceModule -> Err SourceModule
extendModule ms (name,mod) = case mod of
ModMod (Module mt st fs me ops js0) -> do
js <- case mt of
{- --- building the {s : Str} lincat
MTConcrete a -> do
ModMod ma <- lookupModule (MGrammar ms) a
let cats = [c | (c,AbsCat _ _) <- tree2list $ jments ma]
jscs = [(c,CncCat (yes defLinType) nope nope) | c <- cats]
return $ updatesTreeNondestr jscs js0
-}
_ -> return js0
js1 <- case me of
Just n -> do
m0 <- case lookup n ms of
Just (ModMod m) -> do
testErr (sameMType (mtype m) mt)
("illegal extension type to module" +++ prt name)
return m
_ -> Bad $ "cannot find extended module" +++ prt n
extendMod n (jments m0) js
_ -> return js
return $ (name,ModMod (Module mt st fs me ops js1))
type Status = (StatusTree, [(OpenSpec Ident, StatusTree)])
type StatusTree = BinTree (Ident,StatusInfo)