The SLinType type is changed so that you don't have to use enumerateTerms each time when you want to know the possible table arguments

4 files changed, 23 insertions, 25 deletions

diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
index a01deb08a..b6a34a8ce 100644
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ b/src/GF/Conversion/GFCtoSimple.hs
@@ -119,8 +119,8 @@ expandTerm gram term = -- tracePrt "expanded term" prt $
 
 convertCType :: Env -> A.CType -> SLinType
 convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
-convertCType gram (A.Table pt vt) = TblT (convertCType gram pt) (convertCType gram vt)
-convertCType gram ct@(A.Cn con)   = ConT con $ map (convertTerm gram) $ groundTerms gram ct
+convertCType gram (A.Table pt vt) = TblT (enumerateTerms Nothing (convertCType gram pt)) (convertCType gram vt)
+convertCType gram ct@(A.Cn con)   = ConT $ map (convertTerm gram) $ groundTerms gram ct
 convertCType gram (A.TStr)        = StrT
 convertCType gram (A.TInts n)     = error "GFCtoSimple.convertCType: cannot handle 'TInts' constructor"
 
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
index 514f2b382..d6ff052f5 100644
--- a/src/GF/Conversion/SimpleToMCFG/Nondet.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
@@ -136,15 +136,13 @@ simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
 reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
 --reduceTerm ctype path (Variants terms) 
 --    = member terms >>= reduceTerm ctype path
-reduceTerm (StrT)     path term = updateLin (path, term)
-reduceTerm (ConT _ _) path term = do pat <- expandTerm term
-				     updateHead (path, pat)
+reduceTerm (StrT)   path term = updateLin (path, term)
+reduceTerm (ConT _) path term = do pat <- expandTerm term
+				   updateHead (path, pat)
 reduceTerm (RecT rtype) path term
-    = sequence_ [ reduceTerm ctype (path ++. lbl) (term +. lbl) |
-		  (lbl, ctype) <- rtype ]
-reduceTerm (TblT ptype vtype) path table 
-    = sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) |
-		  pat <- enumeratePatterns ptype ]
+    = sequence_ [ reduceTerm ctype (path ++. lbl) (term  +. lbl) | (lbl, ctype) <- rtype ]
+reduceTerm (TblT pats vtype) path table 
+    = sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) | pat <- pats ]
 
 
 ------------------------------------------------------------
@@ -174,7 +172,7 @@ unifyPType arg (RecT prec) =
     sequence [ liftM ((,) lbl) $
 	       unifyPType (arg +. lbl) ptype |
 	       (lbl, ptype) <- prec ]
-unifyPType (Arg nr _ path) (ConT con terms) = 
+unifyPType (Arg nr _ path) (ConT terms) = 
     do (_, args, _, _) <- readState
        case lookup path (ecatConstraints (args !! nr)) of
          Just term -> return term
diff --git a/src/GF/Conversion/SimpleToMCFG/Strict.hs b/src/GF/Conversion/SimpleToMCFG/Strict.hs
index 6ca7c4737..a5519fcd8 100644
--- a/src/GF/Conversion/SimpleToMCFG/Strict.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Strict.hs
@@ -109,7 +109,7 @@ termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, term)) ]
 parPaths :: SLinType -> STerm -> [[(SPath, STerm)]]
 parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
 		      nubsort [ (path, value) | 
-				(path, (ConT _ _, value)) <- termPaths ctype term ]
+				(path, (ConT _, value)) <- termPaths ctype term ]
 
 strPaths :: SLinType -> STerm -> [(SPath, STerm)]
 strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]
diff --git a/src/GF/Formalism/SimpleGFC.hs b/src/GF/Formalism/SimpleGFC.hs
index 63a9ed43f..ea1f9dc12 100644
--- a/src/GF/Formalism/SimpleGFC.hs
+++ b/src/GF/Formalism/SimpleGFC.hs
@@ -79,15 +79,15 @@ term2tterm term = error $ "term2tterm: illegal term"
 -- ** linearization types and terms
 
 data LinType c t = RecT [(Label, LinType c t)]
-		 | TblT (LinType c t) (LinType c t)
-		 | ConT Constr [Term c t]
+		 | TblT [Term c t] (LinType c t)
+		 | ConT [Term c t]
 		 | StrT
 		   deriving (Eq, Ord, Show)
 
 isBaseType :: LinType c t -> Bool
-isBaseType (ConT _ _) = True
-isBaseType (StrT) = True
-isBaseType _ = False
+isBaseType (ConT _) = True
+isBaseType (StrT)   = True
+isBaseType _        = False
 
 data Term c t
     = Arg Int c (Path c t)       -- ^ argument variable, the 'Path' is a path 
@@ -166,12 +166,12 @@ variants terms0 = case concatMap flatten terms0 of
 enumerateTerms :: (Eq c, Eq t) => Maybe (Term c t) -> LinType c t -> [Term c t]
 enumerateTerms arg (StrT) = maybe err return arg
     where err = error "enumeratePatterns: parameter type should not be string"
-enumerateTerms arg (ConT _ terms) = terms
+enumerateTerms arg (ConT terms) = terms
 enumerateTerms arg (RecT rtype) 
     = liftM Rec $ mapM enumAssign rtype
     where enumAssign (lbl, ctype) = liftM ((,) lbl) $ enumerateTerms arg ctype
-enumerateTerms arg (TblT ptype ctype)
-    = liftM Tbl $ mapM enumCase $ enumeratePatterns ptype
+enumerateTerms arg (TblT terms ctype)
+    = liftM Tbl $ mapM enumCase terms
     where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype
 
 enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
@@ -214,12 +214,12 @@ termFollowPath (Path path0) = follow (reverse path0)
 	  follow (Left  lbl : path) term = follow path (term +. lbl)
 
 lintype2paths :: (Eq c, Eq t) => Path c t -> LinType c t -> [Path c t]
-lintype2paths path (ConT _ _)   = []
+lintype2paths path (ConT _)     = []
 lintype2paths path (StrT)       = [ path ]
 lintype2paths path (RecT rec)   = concat [ lintype2paths (path ++. lbl) ctype |
 					   (lbl, ctype) <- rec ]
-lintype2paths path (TblT pt vt) = concat [ lintype2paths (path ++! pat) vt |
-					   pat <- enumeratePatterns pt ]
+lintype2paths path (TblT pts vt)= concat [ lintype2paths (path ++! pat) vt |
+					   pat <- pts ]
 
 ----------------------------------------------------------------------
 -- * pretty-printing
@@ -243,8 +243,8 @@ instance Print TTerm where
 
 instance (Print c, Print t) => Print (LinType c t) where
     prt (RecT rec) = "{" ++ prtPairList ":" "; " rec ++ "}"
-    prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
-    prt (ConT t ts) = prt t ++ "[" ++ prtSep "|" ts ++ "]"
+    prt (TblT ts t2) = "([" ++ prtSep "|" ts ++ "] => " ++ prt t2 ++ ")"
+    prt (ConT ts) = "[" ++ prtSep "|" ts ++ "]"
     prt (StrT) = "Str"
 
 instance (Print c, Print t) => Print (Term c t) where