summaryrefslogtreecommitdiff
path: root/src/GF/Devel/Compile
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2007-12-09 15:20:50 +0000
committeraarne <aarne@cs.chalmers.se>2007-12-09 15:20:50 +0000
commit6edb2f075a5be472fbdf01946a2cba2c17059b49 (patch)
tree1e4116165962f04b5433613622b88a01026c9ccc /src/GF/Devel/Compile
parent6a4218e9efebc8b037cf2410a5e07a3fb20a5069 (diff)
debugging new compilation
Diffstat (limited to 'src/GF/Devel/Compile')
-rw-r--r--src/GF/Devel/Compile/GF.cf2
-rw-r--r--src/GF/Devel/Compile/Optimize.hs21
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
+
+
{-