GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-03 08:12:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

refresh compilation phase in the new format

Browse Source
This commit is contained in:
aarne
2007-12-07 10:23:18 +00:00
parent 64ebc4f167
commit e013138f0c
6 changed files with 80 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
src/GF/Devel/Compile/Refresh.hs
View File

@@ -9,20 +9,33 @@
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.6 $
--
-- (Description of the module)
-- make variable names unique by adding an integer index to each
-----------------------------------------------------------------------------
module GF.Devel.Compile.Refresh (refreshTerm, refreshTermN,
refreshModule
) where
module GF.Devel.Compile.Refresh (
refreshModule,
refreshTerm,
refreshTermN
) where
import GF.Devel.Grammar.Modules
import GF.Devel.Grammar.Terms
import GF.Devel.Grammar.Macros
import GF.Infra.Ident
import GF.Data.Operations
import GF.Grammar.Grammar
import GF.Infra.Ident
import GF.Infra.Modules
import GF.Grammar.Macros
import Control.Monad
-- for concrete and resource in grammar, before optimizing
refreshModule :: Int -> SourceModule -> Err (Int,SourceModule)
refreshModule k (m,mo) = do
(mo',(_,k')) <- appSTM (termOpModule refresh mo) (initIdStateN k)
return (k',(m,mo'))
refreshTerm :: Term -> Err Term
refreshTerm = refreshTermN 0
@@ -103,31 +116,3 @@ refreshEquation :: Equation -> Err ([Patt],Term)
refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) where
refr (ps,t) = liftM2 (,) (mapM refreshPatt ps) (refresh t)
-- for concrete and resource in grammar, before optimizing
refreshGrammar :: SourceGrammar -> Err SourceGrammar
refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules
refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
refreshModule (k,ms) mi@(i,m) = case m of
ModMod mo@(Module mt fs st me ops js) | (isModCnc mo || isModRes mo) -> do
(k',js') <- foldM refreshRes (k,[]) $ tree2list js
return (k', (i, ModMod(Module mt fs st me ops (buildTree js'))) : ms)
_ -> return (k, mi:ms)
where
refreshRes (k,cs) ci@(c,info) = case info of
ResOper ptyp (Yes trm) -> do ---- refresh ptyp
(k',trm') <- refreshTermKN k trm
return $ (k', (c, ResOper ptyp (Yes trm')):cs)
ResOverload tyts -> do
(k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $
appSTM (mapPairsM refresh tyts) (initIdStateN k)
return $ (k', (c, ResOverload tyts'):cs)
CncCat mt (Yes trm) pn -> do ---- refresh mt, pn
(k',trm') <- refreshTermKN k trm
return $ (k', (c, CncCat mt (Yes trm') pn):cs)
CncFun mt (Yes trm) pn -> do ---- refresh pn
(k',trm') <- refreshTermKN k trm
return $ (k', (c, CncFun mt (Yes trm') pn):cs)
_ -> return (k, ci:cs)