"Committed_by_peb"

src/GF/Formalism/GCFG.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/20 12:49:44 $ 
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Basic GCFG formalism (derived from Pollard 1984)
 -----------------------------------------------------------------------------
@@ -45,6 +45,7 @@ instance (Print c, Print n) => Print (Abstract c n) where
 				else " -> " ++ prtSep " " args )
 
 instance (Print l, Print t) => Print (Concrete l t) where
-    prt (Cnc lcat args term) = prt term ++ " : " ++ prt lcat ++ 
-			      ( if null args then ""
-				else " / " ++ prtSep " " args)
+    prt (Cnc lcat args term) = prt term 
+			       ++ " : " ++ prt lcat ++ 
+			       ( if null args then ""
+			         else " / " ++ prtSep " " args)

src/GF/Formalism/MCFG.hs

@@ -4,20 +4,24 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:50 $ 
+-- > CVS $Date: 2005/05/09 09:28:45 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Definitions of multiple context-free grammars
 -----------------------------------------------------------------------------
 
 module GF.Formalism.MCFG where
 
+import Control.Monad (liftM)
+import Data.List (groupBy)
+
 import GF.Formalism.Utilities
 import GF.Formalism.GCFG
 
 import GF.Infra.Print
 
+
 ------------------------------------------------------------
 -- grammar types
 
@@ -35,6 +39,13 @@ instantiateArgs args (Lin lbl lin) = Lin lbl (map instSym lin)
     where instSym = mapSymbol instCat id
 	  instCat (_, lbl, nr) = (args !! nr, lbl, nr)
 
+expandVariants :: Eq lbl => MCFRule cat name lbl tok -> [MCFRule cat name lbl tok]
+expandVariants (Rule abs (Cnc typ typs lins)) = liftM (Rule abs . Cnc typ typs) $
+						expandLins lins
+    where expandLins = sequence . groupBy eqLbl 
+	  eqLbl (Lin l1 _) (Lin l2 _) = l1 == l2
+
+
 ------------------------------------------------------------
 -- pretty-printing
 

src/GF/Formalism/SimpleGFC.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:22:13 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Date: 2005/05/09 09:28:45 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
 --
 -- Simplistic GFC format
 -----------------------------------------------------------------------------
@@ -56,11 +56,12 @@ varsInTTerm tterm = vars tterm []
 
 tterm2term :: TTerm -> Term c t
 tterm2term (con :@ terms) = con :^ map tterm2term terms
-tterm2term (TVar x) = Var x
+-- tterm2term (TVar x) = Var x
+tterm2term term = error $ "tterm2term: illegal term"
 
 term2tterm :: Term c t -> TTerm
 term2tterm (con :^ terms) = con :@ map term2tterm terms
-term2tterm (Var x) = TVar x
+-- term2tterm (Var x) = TVar x
 term2tterm term = error $ "term2tterm: illegal term"
 
 -- ** linearization types and terms
@@ -88,8 +89,8 @@ data Term c t
     | Term c t :++ Term c t      -- ^ concatenation
     | Token t   -- ^ single token
     | Empty     -- ^ empty string
-    | Wildcard  -- ^ wildcard pattern variable
-    | Var Var   -- ^ bound pattern variable
+    ---- | Wildcard  -- ^ wildcard pattern variable
+    ---- | Var Var   -- ^ bound pattern variable
 
      -- Res CIdent        -- ^ resource identifier
      -- Int Integer       -- ^ integer
@@ -113,6 +114,27 @@ Arg arg cat path +! pat = Arg arg cat (path ++! pat)
 term@(Tbl table) +! pat = maybe (term :! pat) id $ lookup pat table
 term +! pat = term :! pat
 
+{- does not work correctly:
+lookupTbl term [] _ = term
+lookupTbl _ ((Wildcard, term) : _) _ = term
+lookupTbl _ ((Var x, term) : _) pat = subst x pat term
+lookupTbl _ ((pat', term) : _) pat | pat == pat' = term
+lookupTbl term (_ : tbl) pat = lookupTbl term tbl pat
+
+subst x a (Arg n c (Path path)) = Arg n c (Path (map substP path))
+    where substP (Right (Var y)) | x==y = Right a
+	  substP p = p
+subst x a (con :^ ts) = con :^ map (subst x a) ts
+subst x a (Rec rec) = Rec [ (l, subst x a t) | (l, t) <- rec ]
+subst x a (t :. l) = subst x a t +. l
+subst x a (Tbl tbl) = Tbl [ (subst x a p, subst x a t) | (p, t) <- tbl ]
+subst x a (t :! s) = subst x a t +! subst x a s
+subst x a (Variants ts) = variants $ map (subst x a) ts
+subst x a (t1 :++ t2) = subst x a t1 ?++ subst x a t2
+subst x a (Var y) | x==y = a
+subst x a t = t
+-}
+
 (?++) :: Term c t -> Term c t -> Term c t
 Variants terms ?++ term  = variants $ map (?++ term) terms
 term  ?++ Variants terms = variants $ map (term ?++) terms
@@ -213,10 +235,10 @@ instance (Print c, Print t) => Print (Term c t) where
     prt (t1 :++ t2) = prt t1 ++ "++" ++ prt t2
     prt (Token t)   = "'" ++ prt t ++ "'"
     prt (Empty)     = "[]"
-    prt (Wildcard)  = "_"
     prt (term :. lbl) = prt term ++ "." ++ prt lbl
     prt (term :! sel) = prt term ++ "!" ++ prt sel
-    prt (Var var) = "?" ++ prt var
+--    prt (Wildcard)  = "_"
+--    prt (Var var) = "?" ++ prt var
 
 instance (Print c, Print t) => Print (Path c t) where
     prt (Path path) = concatMap prtEither (reverse path)