From 3e788e5bbd5d2a00387c2f73beb9b3a1964a3265 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sun, 9 Dec 2007 15:20:50 +0000
Subject: [PATCH] debugging new compilation

---
 src/GF/Devel/Compile/GF.cf        |  2 +-
 src/GF/Devel/Compile/Optimize.hs  | 21 +++++++++++++++++----
 src/GF/Devel/Grammar/Compute.hs   |  2 +-
 src/GF/Devel/Grammar/Construct.hs |  6 +++++-
 4 files changed, 24 insertions(+), 7 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
+
+
 
 
 {-
diff --git a/src/GF/Devel/Grammar/Compute.hs b/src/GF/Devel/Grammar/Compute.hs
index 449cd3b90..6835fdbe1 100644
--- a/src/GF/Devel/Grammar/Compute.hs
+++ b/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'
diff --git a/src/GF/Devel/Grammar/Construct.hs b/src/GF/Devel/Grammar/Construct.hs
index bc966fcf6..6d77c1c31 100644
--- a/src/GF/Devel/Grammar/Construct.hs
+++ b/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