fixed bug with prawitz transform of course-of-values tables in Compute

2 files changed, 16 insertions, 3 deletions

diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs
index 87709265f..877a9ee73 100644
--- a/src/GF/Devel/GrammarToGFCC.hs
+++ b/src/GF/Devel/GrammarToGFCC.hs
@@ -391,10 +391,15 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
    --- this is mainly needed for parameter record projections
    ---- was: errVal t $ Compute.computeConcreteRec cgr t
    comp t = case t of
-     S (V typ ts) v0 -> errVal t $ do
+     T (TComp typ) ts  -> comp $ V typ (map (comp . snd) ts)  ---- should
+     T (TTyped typ) ts -> comp $ V typ (map (comp . snd) ts) ---- should
+     V typ ts -> V typ (map comp ts)
+     S (V typ ts) v0 -> err error id $ do
        let v = comp v0 
        vs <- Look.allParamValues cgr typ
-       return $ maybe t (comp . (ts !!)) $ lookup v (zip vs [0 .. length vs - 1])
+       return $ maybe t ---- (error (prt t)) -- should be safe after doVar though
+                      (comp . (ts !!)) $ lookup v (zip vs [0 .. length vs - 1])
+     R r -> R [(l,(ty,comp t)) | (l,(ty,t)) <- r]
      P (R r) l -> maybe t (comp . snd) $ lookup l r
      _ -> GM.composSafeOp comp t
 
@@ -481,6 +486,6 @@ unlockTyp = filter notlock where
      _ -> True
 
 prtTrace tr n = 
-  trace ("-- INTERNAL COMPILER ERROR" +++ A.prt tr ++++ show tr ++++ show n) n
+  trace ("-- INTERNAL COMPILER ERROR" +++ A.prt tr ++++ show n) n
 prTrace  tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n
 
diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index cccbb2ca4..e3185849c 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -90,6 +90,7 @@ computeTermOpt rec gr = comp where
          (Alias _ _ d, _) -> comp g (App d a')
 
          (S (T i cs) e,_) -> prawitz g i (flip App a') cs e
+         (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e
 
 	 _ -> do
            (t',b) <- appPredefined (App f' a')
@@ -122,6 +123,7 @@ computeTermOpt rec gr = comp where
          Alias _ _ r -> comp g (P r l)
 
          S (T i cs) e -> prawitz g i (flip P l) cs e
+         S (V i cs) e -> prawitzV g i (flip P l) cs e
 
          _   -> returnC $ P t' l
 
@@ -197,6 +199,7 @@ computeTermOpt rec gr = comp where
          Alias _ _ d -> comp g (S d v')
 
          S (T i cs) e -> prawitz g i (flip S v') cs e
+         S (V i cs) e -> prawitzV g i (flip S v') cs e
          _    -> returnC $ S t' v'
 
      -- normalize away empty tokens
@@ -219,6 +222,8 @@ computeTermOpt rec gr = comp where
 
          (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e
          (s, S (T i cs) e) -> prawitz g i (Glue s) cs e
+         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e
+         (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e
          (_,Empty)         -> return x
          (Empty,_)         -> return y
          (K a, K b)        -> return $ K (a ++ b)
@@ -373,6 +378,9 @@ computeTermOpt rec gr = comp where
      prawitz g i f cs e = do
        cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs]
        return $ S (T i cs') e
+     prawitzV g i f cs e = do
+       cs' <- mapM (comp g) [(f v) | v <- cs]
+       return $ S (V i cs') e
 
 -- | argument variables cannot be glued
 checkNoArgVars :: Term -> Err Term