From be81ac50a9ecf2b6457d4594a4b67972a1b0dd75 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 2 Oct 2003 06:37:34 +0000
Subject: [PATCH] Added dir for parsing.

---
 src/GF/Compile/ShellState.hs | 12 +++++++++++-
 src/GF/Grammar/AbsCompute.hs |  2 +-
 src/GF/Grammar/LookAbs.hs    |  6 +++---
 src/GF/Grammar/TC.hs         |  4 ++++
 src/GF/Grammar/TypeCheck.hs  |  2 +-
 src/Today.hs                 |  2 +-
 6 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 661e1bedd..85bc24ae0 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -187,13 +187,23 @@ optionsOfLang st = stateOptions   . stateGrammarOfLang st
 -- the last introduced grammar, stored in options, is the default for operations
 
 firstStateGrammar :: ShellState -> StateGrammar
-firstStateGrammar st = errVal emptyStateGrammar $ do
+firstStateGrammar st = errVal (stateAbstractGrammar st) $ do
   concr <- maybeErr "no concrete syntax" $ concrete st 
   return $ stateGrammarOfLang st concr
 
 mkStateGrammar :: ShellState -> Language -> StateGrammar
 mkStateGrammar = stateGrammarOfLang
 
+stateAbstractGrammar :: ShellState -> StateGrammar
+stateAbstractGrammar st = StGr {
+  absId   = maybe (identC "Abs") id (abstract st), ---
+  cncId   = identC "#Cnc", ---
+  grammar = canModules st, ---- only abstarct ones
+  cf      = emptyCF,
+  morpho  = emptyMorpho
+  }
+
+
 -- analysing shell state into parts
 globalOptions = gloptions
 allLanguages  = map fst . concretes
diff --git a/src/GF/Grammar/AbsCompute.hs b/src/GF/Grammar/AbsCompute.hs
index daa13955e..d80fc57f3 100644
--- a/src/GF/Grammar/AbsCompute.hs
+++ b/src/GF/Grammar/AbsCompute.hs
@@ -20,7 +20,7 @@ computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
 computeAbsTerm gr = computeAbsTermIn gr []
 
 computeAbsTermIn :: GFCGrammar -> [Ident] -> Exp -> Err Exp
-computeAbsTermIn gr = compt where
+computeAbsTermIn gr xs e = errIn ("computing" +++ prt e) $ compt xs e where
   compt vv t = case t of
     Prod x a b  -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
     Abs x b     -> liftM  (Abs  x)              (compt (x:vv) b)
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 66d6e4ca3..04b6286e9 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -13,7 +13,7 @@ import Monad
 type GFCGrammar = C.CanonGrammar
 
 lookupAbsDef :: GFCGrammar -> Ident -> Ident -> Err (Maybe Term)
-lookupAbsDef gr m c = do
+lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
   mi   <- lookupModule gr m
   case mi of
     ModMod mo -> do
@@ -25,7 +25,7 @@ lookupAbsDef gr m c = do
     _ -> Bad $ prt m +++ "is not an abstract module"
 
 lookupFunType :: GFCGrammar -> Ident -> Ident -> Err Type
-lookupFunType gr m c = do
+lookupFunType gr m c = errIn ("looking up funtype of" +++ prt c) $ do
   mi   <- lookupModule gr m
   case mi of
     ModMod mo -> do
@@ -37,7 +37,7 @@ lookupFunType gr m c = do
     _ -> Bad $ prt m +++ "is not an abstract module"
 
 lookupCatContext :: GFCGrammar -> Ident -> Ident -> Err Context
-lookupCatContext gr m c = do
+lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
   mi   <- lookupModule gr m
   case mi of
     ModMod mo -> do
diff --git a/src/GF/Grammar/TC.hs b/src/GF/Grammar/TC.hs
index ce9da979d..88e66379c 100644
--- a/src/GF/Grammar/TC.hs
+++ b/src/GF/Grammar/TC.hs
@@ -118,6 +118,7 @@ inferExp :: Theory -> TCEnv -> Exp -> Err (AExp, Val, [(Val,Val)])
 inferExp th tenv@(k,rho,gamma) e = case e of
   Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
   Q m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
+  QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
   Sort _ -> return (AType, vType, [])
   App f t -> do
     (f',w,csf) <- inferExp th tenv f 
@@ -187,6 +188,9 @@ checkPatt th tenv exp val = do
      Q m c  -> do
        typ <- lookupConst th (m,c)
        return $ (ACn (m,c) typ, typ, [])
+     QC m c  -> do
+       typ <- lookupConst th (m,c)
+       return $ (ACn (m,c) typ, typ, []) ----
      App f t -> do
        (f',w,csf) <- checkExpP tenv f val
        typ <- whnf w
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
index a3487fdf7..5f16da90e 100644
--- a/src/GF/Grammar/TypeCheck.hs
+++ b/src/GF/Grammar/TypeCheck.hs
@@ -231,7 +231,7 @@ editAsTermCommand gr c e = err (const []) singleton $ do
   return $ tree2exp $ loc2tree t'
 
 exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
-exp2termCommand gr f t = do
+exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
   let exp = tree2exp t
   exp2 <- f exp
   annotate gr exp2
diff --git a/src/Today.hs b/src/Today.hs
index 81d5b4dba..44ffd43d8 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Wed Oct  1 15:37:15 CEST 2003"
+module Today where today = "Thu Oct  2 09:28:27 CEST 2003"