debugging new compilation

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
 

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
+
+
 
 
 {-

src/GF/Devel/Grammar/Compute.hs

@@ -63,7 +63,7 @@ computeTermOpt rec gr = comp where
      ---- Computed t' -> return $ unComputed t'
 
      Vr x -> do
-       t' <- maybe (prtBad ("no value given to variable") x) return $ lookup x g
+       t' <- maybe (prtBad ("no value for variable") x) return $ lookup x g
        case t' of 
          _ | t == t' -> return t
          _ -> comp g t'

src/GF/Devel/Grammar/Construct.hs

@@ -149,7 +149,11 @@ unifyJudgement old new = do
 ----               (unwords ["illegal update of",prt oterm,"to",prt nterm])
        return nterm
 
-
+updateJudgement :: Ident -> Ident -> Judgement -> GF -> Err GF
+updateJudgement m c ju gf = do
+  mo  <- maybe (Bad (show m)) return $ Data.Map.lookup m $ gfmodules gf
+  let mo' = mo {mjments = insert c ju (mjments mo)}
+  return $ gf {gfmodules = insert m mo' (gfmodules gf)}
 
 -- abstractions on Term