From 08c9a2ab8cf7b77a5c0392f5f8e9643e39c89c5b Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Tue, 9 Dec 2003 16:39:24 +0000
Subject: Introduced output of stripped format gfcm.

---
 src/GF/Grammar/Compute.hs | 7 +++++--
 src/GF/Grammar/Macros.hs  | 3 +++
 2 files changed, 8 insertions(+), 2 deletions(-)

(limited to 'src/GF/Grammar')

diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index e400bce4e..6c557b479 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -25,7 +25,7 @@ computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t
 computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term
 computeTerm gr = comp where
 
-   comp g t = --- errIn ("subterm" +++ prt t) $ --- for debugging 
+   comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
               case t of
 
      Q (IC "Predef") _ -> return t
@@ -59,6 +59,7 @@ computeTerm gr = comp where
        a' <- comp g a
        case (f',a') of
          (Abs x b,_) -> comp (ext x a' g) b
+         (QC _ _,_)  -> returnC $ App f' a'
          (FV fs, _)  -> mapM (\c -> comp g (App c a')) fs >>= return . FV
          (_, FV as)  -> mapM (\c -> comp g (App f' c)) as >>= return . FV
 
@@ -172,8 +173,10 @@ computeTerm gr = comp where
          _ -> return $ ExtR r' s'
 
      -- case-expand tables
+     -- if already expanded, don't expand again
      T i@(TComp _) cs -> do
-       cs' <- mapPairsM (comp g) cs
+       -- if there are no variables, don't even go inside
+       cs' <- if (null g) then return cs else mapPairsM (comp g) cs
        return $ T i cs'
 
      T i cs -> do
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 2edb183a1..291ea7521 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -175,6 +175,9 @@ appc = appCons . zIdent
 mkLet :: [LocalDef] -> Term -> Term
 mkLet defs t = foldr Let t defs
 
+mkLetUntyped :: Context -> Term -> Term
+mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs]
+
 isVariable (Vr _ ) = True
 isVariable _ = False
 
-- 
cgit v1.2.3