diff options
| author | aarne <aarne@cs.chalmers.se> | 2007-12-09 15:20:50 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2007-12-09 15:20:50 +0000 |
| commit | 6edb2f075a5be472fbdf01946a2cba2c17059b49 (patch) | |
| tree | 1e4116165962f04b5433613622b88a01026c9ccc /src/GF/Devel/Compile | |
| parent | 6a4218e9efebc8b037cf2410a5e07a3fb20a5069 (diff) | |
debugging new compilation
Diffstat (limited to 'src/GF/Devel/Compile')
| -rw-r--r-- | src/GF/Devel/Compile/GF.cf | 2 | ||||
| -rw-r--r-- | src/GF/Devel/Compile/Optimize.hs | 21 |
2 files changed, 18 insertions, 5 deletions
diff --git a/src/GF/Devel/Compile/GF.cf b/src/GF/Devel/Compile/GF.cf index 6fc9307b2..2de298ace 100644 --- a/src/GF/Devel/Compile/GF.cf +++ b/src/GF/Devel/Compile/GF.cf @@ -13,7 +13,7 @@ comment "{-" "-}" ; -- identifiers -position token PIdent (letter | '_') (letter | digit | '_' | '\'')* ; +position token PIdent ('_')? letter (letter | digit | '_' | '\'')* ; -- the top-level grammar diff --git a/src/GF/Devel/Compile/Optimize.hs b/src/GF/Devel/Compile/Optimize.hs index 1d5024714..746b47b90 100644 --- a/src/GF/Devel/Compile/Optimize.hs +++ b/src/GF/Devel/Compile/Optimize.hs @@ -22,11 +22,11 @@ import GF.Devel.Grammar.Compute --import GF.Infra.Ident ---import GF.Grammar.Lookup +import GF.Devel.Grammar.Lookup --import GF.Grammar.Refresh --import GF.Compile.BackOpt ---import GF.Devel.CheckGrammar +import GF.Devel.Compile.CheckGrammar --import GF.Compile.Update @@ -45,8 +45,8 @@ import Debug.Trace optimizeModule :: Options -> GF -> SourceModule -> Err SourceModule optimizeModule opts gf0 sm@(m,mo) = case mtype mo of MTConcrete _ -> opt sm - MTInstance _ -> opt sm - MTGrammar -> opt sm + MTInstance _ -> optr sm + MTGrammar -> optr sm _ -> return sm where gf = gf0 {gfmodules = Map.insert m mo (gfmodules gf0)} @@ -54,6 +54,19 @@ optimizeModule opts gf0 sm@(m,mo) = case mtype mo of mo' <- termOpModule (computeTerm gf) mo return (m,mo') + optr (m,mo)= do + let deps = allOperDependencies m $ mjments mo + ids <- topoSortOpers deps + gf' <- foldM evalOp gf ids + mo' <- lookupModule gf' m + return $ (m,mo') + where + evalOp gf i = do + ju <- lookupJudgement gf m i + def' <- computeTerm gf (jdef ju) + updateJudgement m i (ju {jdef = def'}) gf + + {- |
