"Committed_by_peb"

2 files changed, 13 insertions, 16 deletions

diff --git a/src/GF/Formalism/SimpleGFC.hs b/src/GF/Formalism/SimpleGFC.hs
index dfddc212d..537f4f568 100644
--- a/src/GF/Formalism/SimpleGFC.hs
+++ b/src/GF/Formalism/SimpleGFC.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- Simplistic GFC format
 -----------------------------------------------------------------------------
@@ -52,7 +52,7 @@ decl2cat (Decl _ cat _) = cat
 varsInTTerm :: TTerm -> [Var]
 varsInTTerm tterm = vars tterm []
     where vars (TVar x)  = (x:)
-	  vars (_ :@ ts) = foldr (.) id $ map vars ts
+	  vars (_ :@ ts) = foldr (.) id $ map vars ts
 
 tterm2term :: TTerm -> Term c t
 tterm2term (con :@ terms) = con :^ map tterm2term terms
@@ -108,9 +108,9 @@ term +. lbl = term :. lbl
 Variants terms +! pat = variants $ map (+! pat) terms 
 term +! Variants pats = variants $ map (term +!) pats 
 term +! arg@(Arg _ _ _) = term :! arg
-Tbl table +! pat = maybe err id $ lookup pat table
-    where err = error $ "(+!): pattern not in table"
 Arg arg cat path +! pat = Arg arg cat (path ++! pat)
+-- cannot handle tables with pattern variales or wildcards (yet):
+term@(Tbl table) +! pat = maybe (term :! pat) id $ lookup pat table
 term +! pat = term :! pat
 
 (?++) :: Term c t -> Term c t -> Term c t
@@ -141,7 +141,7 @@ enumerateTerms arg (TblT ptype ctype)
     where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype
 
 enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
-enumeratePatterns = enumerateTerms Nothing
+enumeratePatterns t = enumerateTerms Nothing t
 
 ----------------------------------------------------------------------
 
@@ -198,7 +198,7 @@ instance Print TTerm where
     prt (TVar var)  = "?" ++ prt var
 
 instance (Print c, Print t) => Print (LinType c t) where
-    prt (RecT rec) = "{" ++ prtInterior ":" rec ++ "}"
+    prt (RecT rec) = "{" ++ prtPairList ":" "; " rec ++ "}"
     prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
     prt (ConT t ts) = prt t ++ "[" ++ prtSep "|" ts ++ "]"
     prt (StrT) = "Str"
@@ -207,8 +207,8 @@ instance (Print c, Print t) => Print (Term c t) where
     prt (Arg n c p) = prt c ++ prt n ++ prt p
     prt (c :^ [])  = prt c 
     prt (c :^ ts)  = "(" ++ prt c ++ prtBefore " " ts ++ ")"
-    prt (Rec rec)   = "{" ++ prtInterior "=" rec ++ "}"
-    prt (Tbl tbl)   = "[" ++ prtInterior "=>" tbl ++ "]"
+    prt (Rec rec)   = "{" ++ prtPairList "=" "; " rec ++ "}"
+    prt (Tbl tbl)   = "[" ++ prtPairList "=>" "; " tbl ++ "]"
     prt (Variants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
     prt (t1 :++ t2) = prt t1 ++ "++" ++ prt t2
     prt (Token t)   = "'" ++ prt t ++ "'"
@@ -218,9 +218,6 @@ instance (Print c, Print t) => Print (Term c t) where
     prt (term :! sel) = prt term ++ "!" ++ prt sel
     prt (Var var) = "?" ++ prt var
 
-prtInterior sep xys = if null str then str else init (init str) 
-    where str = concat [ prt x ++ sep  ++ prt y ++ "; " | (x,y) <- xys ]
-
 instance (Print c, Print t) => Print (Path c t) where
     prt (Path path) = concatMap prtEither (reverse path)
 	where prtEither (Left  lbl)  = "." ++ prt lbl
diff --git a/src/GF/Formalism/Utilities.hs b/src/GF/Formalism/Utilities.hs
index a03464e04..f4a6e8e2c 100644
--- a/src/GF/Formalism/Utilities.hs
+++ b/src/GF/Formalism/Utilities.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Basic type declarations and functions for grammar formalisms
 -----------------------------------------------------------------------------
@@ -150,7 +150,7 @@ compactForests :: Ord n => [SyntaxForest n] -> SList (SyntaxForest n)
 compactForests = map joinForests . groupBy eqNames . sortForests
     where eqNames f g    = forestName f == forestName g
 	  sortForests    = foldMerge mergeForests [] . map return 
-	  mergeForests [] gs = gs
+	  mergeForests [] gs = gs
 	  mergeForests fs [] = fs
 	  mergeForests fs@(f:fs') gs@(g:gs') 
 	      = case forestName f `compare` forestName g of
@@ -163,7 +163,7 @@ compactForests = map joinForests . groupBy eqNames . sortForests
 					  compactDaughters $
 					  concat [ fss | FNode _ fss <- fs ]
 	  compactDaughters fss = case head fss of
-				   []  -> [[]]
+				   []  -> [[]]
 				   [_] -> map return $ compactForests $ concat fss
 				   _   -> nubsort fss
 -}