more debugging of GrammarToGFCC

src/GF/Conversion/SimpleToFCFG.hs

@@ -127,6 +127,10 @@ convertTerm :: TermMap -> TermSelector -> Term -> LinRec -> CnvMonad LinRec
 convertTerm cnc_defs selector (V nr)       ((lbl_path,lin) : lins) = convertArg selector nr []    lbl_path lin lins
 convertTerm cnc_defs selector (C nr)       ((lbl_path,lin) : lins) = convertCon selector nr       lbl_path lin lins
 convertTerm cnc_defs selector (R record)   ((lbl_path,lin) : lins) = convertRec cnc_defs selector 0 record lbl_path lin lins
+
+----convertTerm cnc_defs selector (P term (R ts)) lins = 
+----  convertTerm cnc_defs selector (foldl P term ts) lins  ---- ?? AR 2/10/2007
+
 convertTerm cnc_defs selector (P term sel)                   lins  = do nr <- evalTerm cnc_defs [] sel
                                                                         convertTerm cnc_defs (TuplePrj nr selector) term lins
 convertTerm cnc_defs selector (FV vars)                      lins  = do term <- member vars
@@ -213,11 +217,14 @@ unifyPType nr path (C max_index) =
 		          return index
 unifyPType nr path (RP alias _) = unifyPType nr path alias
 
+unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007
+
 selectTerm :: FPath -> Term -> Term
 selectTerm []           term        = term
 selectTerm (index:path) (R  record) = selectTerm path (record !! index)
 selectTerm path         (RP _ term) = selectTerm path term
 
+
 ----------------------------------------------------------------------
 -- FRulesEnv
 

src/GF/Devel/GrammarToGFCC.hs

@@ -7,6 +7,7 @@ import qualified GF.Canon.GFCC.AbsGFCC as C
 import qualified GF.Canon.GFCC.PrintGFCC as Pr
 import qualified GF.Grammar.Abstract as A
 import qualified GF.Grammar.Macros as GM
+import qualified GF.Grammar.Compute as Compute
 import qualified GF.Infra.Modules as M
 import qualified GF.Infra.Option as O
 
@@ -271,10 +272,10 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
 
    mkValCase tr = case appSTM (doVar tr) [] of
      Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st
-     _ -> valNum tr
+     _ -> valNum $ comp tr
 
    --- this is mainly needed for parameter record projections
-   comp t = t ----- $ Look.ccompute cgr [] t
+   comp t = errVal t $ Compute.computeTerm cgr [] t
 
    doVar :: Term -> STM [((Type,[Term]),(Term,Term))] Term
    doVar tr = case getLab tr of
@@ -328,11 +329,11 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
           _ -> valNumFV $ tryVar tr
         _ -> valNumFV $ tryVar tr
       tryVar tr = case GM.appForm tr of
-        ---(c, ts) -> [ts' | ts' <- combinations (map tryVar ts)]
+        (c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryVar ts)]
         (FV ts,_) -> ts
         _ -> [tr]
       valNumFV ts = case ts of
-        [tr] -> EInt 66667 ----K (KS (A.prt tr +++ prtTrace tr "66667"))
+        [tr] -> K (A.prt tr ++ "66667")
         _ -> FV $ map valNum ts
 
    mkCurry trm = case trm of
@@ -355,6 +356,15 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
 mkLab k = LIdent (("_" ++ show k))
 
 
+{-
+{CommonScand.VI} ({CommonScand.VSupin} (table ({CommonScand.VType} ) {
+  CommonScand.VAct => {CommonScand.Act} ;
+  CommonScand.VPass => {CommonScand.Pass} ;
+  CommonScand.VRefl => {CommonScand.Act} 
+} ! {CommonScand.VAct}
+-}
+
+
 -- remove lock fields; in fact, any empty records and record types
 unlock = filter notlock where
   notlock (l,(_, t)) = case t of --- need not look at l

src/GF/Grammar/Compute.hs

@@ -278,10 +278,10 @@ computeTermOpt rec gr = comp where
 
      -- case-expand tables
      -- if already expanded, don't expand again
-     T i@(TComp _) cs -> do
+     T i@(TComp ty) cs -> do
        -- 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'
+       return $ {- V ty (map snd cs') --- -} T i cs'
      --- this means some extra work; should implement TSh directly
      TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps]
 
@@ -296,7 +296,7 @@ computeTermOpt rec gr = comp where
            ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
            ps   <- mapM term2patt vs
            let ps' = ps --- PT ptyp (head ps) : tail ps
-           return $ --- V ptyp ts -- to save space, just course of values
+           return $ ---- V ptyp ts -- to save space, just course of values
                     T (TComp ptyp) (zip ps' ts)
          _ -> do
            cs' <- mapM (compBranch g) cs