simplify the Profile type and remove the NameProfile type

src-3.0/GF/Formalism/FCFG.hs

@@ -22,11 +22,8 @@ module GF.Formalism.FCFG
          , FIndex
          , FSymbol(..)
 
-         -- * Name
-         , FName
-         , isCoercionF
-
          -- * Grammar
+         , Profile
          , FPointPos
          , FGrammar
          , FRule(..)
@@ -38,7 +35,7 @@ import Data.Array
 import qualified Data.Map as Map
 
 import GF.Formalism.Utilities
-import qualified GF.GFCC.CId as AbsGFCC
+import GF.GFCC.CId
 import GF.Infra.PrintClass
 
 ------------------------------------------------------------
@@ -66,27 +63,19 @@ data FSymbol
   | FSymTok FToken
 
 
-------------------------------------------------------------
--- Name
-type FName     = NameProfile AbsGFCC.CId
-
-isCoercionF :: FName -> Bool
-isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.wildCId
-isCoercionF _ = False
-
-
 ------------------------------------------------------------
 -- Grammar
 
+type Profile   = [Int]
 type FPointPos = Int
-type FGrammar  = ([FRule], Map.Map AbsGFCC.CId [FCat])
-data FRule     = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
+type FGrammar  = ([FRule], Map.Map CId [FCat])
+data FRule     = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
 
 ------------------------------------------------------------
 -- pretty-printing
 
-instance Print AbsGFCC.CId where
-    prt = AbsGFCC.prCId
+instance Print CId where
+    prt = prCId
 
 instance Print FSymbol where
     prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
@@ -100,6 +89,11 @@ instance Print FSymbol where
     prtList = prtSep " "
 
 instance Print FRule where
-    prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
-                                     " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+    prt (FRule fun profile args res lins) =
+      prt fun ++ prtProf profile ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
+      " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+      where
+        prtProf []   = "?"
+	prtProf args = prtSep "=" args
+
     prtList = prtSep "\n"

src-3.0/GF/Formalism/Utilities.hs

@@ -309,66 +309,6 @@ forest2trees (FMeta)     = [TMeta]
 ----------------------------------------------------------------------
 -- * profiles
 
--- | Pairing a rule name with a profile
-data NameProfile a = Name a [Profile (SyntaxForest a)]
-		     deriving (Eq, Ord, Show)
-
-name2fun :: NameProfile a -> a
-name2fun (Name fun _) = fun
-
--- | A profile is a simple representation of a function on a number of arguments.
--- We only use lists of profiles
-data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
-			     -- 'Unify []' will become a metavariable,
-			     -- 'Unify [a,b]' means that the arguments are equal,
-	       | Constant a
-		 deriving (Eq, Ord, Show)
-
-instance Functor Profile where
-    fmap f (Constant a) = Constant (f a)
-    fmap f (Unify xs)   = Unify xs
-
--- | a function name where the profile does not contain arguments 
--- (i.e. denoting a constant, not a function)
-constantNameToForest :: NameProfile a -> SyntaxForest a
-constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile] 
-    where unConstant (Constant a) = a
-	  unConstant (Unify [])   = FMeta
-	  unConstant _ = error $ "constantNameToForest: the profile should not contain arguments"
-
--- | profile application; we need some way of unifying a list of arguments
-applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
-applyProfile unify profile args = map apply profile
-    where apply (Unify xs)  = unify $ map (args !!) xs
-	  apply (Constant a) = a
-
--- | monadic profile application
-applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
-applyProfileM unify profile args = mapM apply profile
-    where apply (Unify xs)  = unify $ map (args !!) xs
-	  apply (Constant a) = return a
-
--- | profile composition: 
--- 
--- >   applyProfile u z (ps `composeProfiles` qs) args
--- >      ==
--- >   applyProfile u z ps (applyProfile u z qs args)
---
--- compare with function composition
---
--- >   (p . q) arg
--- >      ==
--- >   p (q arg)
---
--- Note that composing an 'Constant' with two or more arguments returns an error
--- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
-composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
-composeProfiles ps qs = map compose ps
-    where compose (Unify [x]) = qs !! x
-	  compose (Unify xs)  = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
-	  compose constant    = constant
-
-
 
 ------------------------------------------------------------
 -- pretty-printing
@@ -411,13 +351,3 @@ instance (Print s) => Print (SyntaxForest s) where
     prt (FFloat  f) = show f
     prt (FMeta)     = "?"
     prtList = prtAfter "\n"
-
-instance Print a => Print (Profile a) where
-    prt (Unify [])   = "?"
-    prt (Unify args) = prtSep "=" args
-    prt (Constant a) = prt a
-
-instance Print a => Print (NameProfile a) where
-    prt (Name fun profile) = prt fun ++ prt profile
-
-