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

lib/resource-1.0/Makefile

@@ -156,7 +156,9 @@ gfdoc:
 	cp */Irreg???.gf doc/gfdoc
 	mv ../prelude/*.html doc/gfdoc
 
-gf3:
+gf3: gf3present gf3alltenses
+
+gf3alltenses:
 #	$(GFNew) arabic/GrammarAra.gf
 #	$(GFNew) catalan/Catalan.gf
 	$(GFNew) danish/Danish.gf

lib/resource-1.0/spanish/DiffSpa.gf

@@ -70,8 +70,8 @@ instance DiffSpa of DiffRomance = open CommonRomance, PhonoSpa, BeschSpa, Prelud
           CPron ag an ap => <argPron ag an ap dative, ap,True> ;
           _ => <[],P2,False>
           }
-       in case <paccp.p2, pdatp.p2> of {
+       in case <<paccp.p2, pdatp.p2> : Person * Person> of {
-         <P3,P3> => <"se" ++ paccp.p1, [],True> ;
+          <P3,P3> => <"se" ++ paccp.p1, [],True> ;
          _       => <pdatp.p1 ++ paccp.p1, [],orB paccp.p3 pdatp.p3>
          } ;
 
@@ -139,7 +139,7 @@ instance DiffSpa of DiffRomance = open CommonRomance, PhonoSpa, BeschSpa, Prelud
           _ => eux
           } ;
       in 
-      \g,n,p -> case <g,n,p> of { 
+      \g,n,p -> case <<g,n,p> : Gender * Number * Person> of { 
         <_,Sg,P1> => cases "me" "mí" ;
         <_,Sg,P2> => cases "te" "tí" ;
         <_,Pl,P1> => cases "nos" "nosotras" ; --- nosotros

lib/resource-1.0/spanish/ResSpa.gf

@@ -8,6 +8,6 @@
 
 instance ResSpa of ResRomance = DiffSpa ** open CommonRomance, Prelude in {
 
-  flags optimize=noexpand ;
+---  flags optimize=noexpand ;
 
 } ;

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
 

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