simplify the Profile type and remove the NameProfile type

2 files changed, 27 insertions, 56 deletions

diff --git a/src-3.0/GF/GFCC/GFCCtoJS.hs b/src-3.0/GF/GFCC/GFCCtoJS.hs
index 91dd89b09..abf7e45a9 100644
--- a/src-3.0/GF/GFCC/GFCCtoJS.hs
+++ b/src-3.0/GF/GFCC/GFCCtoJS.hs
@@ -8,7 +8,6 @@ import qualified GF.JavaScript.PrintJS as JS
 
 import GF.Formalism.FCFG
 import GF.Parsing.FCFG.PInfo
-import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
 
 import GF.Text.UTF8
 import GF.Data.ErrM
@@ -97,29 +96,19 @@ parser2js start p  = [new "Parser" [JS.EStr start,
     cats (c,is) = JS.Prop (JS.IdentPropName (JS.Ident (prCId c))) (JS.EArray (map JS.EInt is))
 
 frule2js :: FRule -> JS.Expr
-frule2js (FRule n args res lins) = new "Rule" [JS.EInt res, name2js n, JS.EArray (map JS.EInt args), lins2js lins]
+frule2js (FRule f ps args res lins) = new "Rule" [JS.EInt res, name2js (f,ps), JS.EArray (map JS.EInt args), lins2js lins]
 
-name2js :: FName -> JS.Expr
-name2js n = case n of
-              Name f [p] | f == wildCId -> fromProfile p
-              Name f ps -> new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
+name2js :: (CId,[Profile]) -> JS.Expr
+name2js (f,ps) | f == wildCId = fromProfile (head ps)
+               | otherwise    = new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
   where
-    fromProfile :: Profile (SyntaxForest CId) -> JS.Expr
-    fromProfile (Unify []) = new "MetaVar" []
-    fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = new "Unify" [JS.EArray (map daughter args)]
-    fromProfile (Constant forest) = fromSyntaxForest forest
+    fromProfile :: Profile -> JS.Expr
+    fromProfile []   = new "MetaVar" []
+    fromProfile [x]  = daughter x
+    fromProfile args = new "Unify" [JS.EArray (map daughter args)]
 
     daughter i = new "Arg" [JS.EInt i]
 
-    fromSyntaxForest :: SyntaxForest CId -> JS.Expr
-    fromSyntaxForest FMeta = new "MetaVar" []
-    -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = new "FunApp" $ [JS.EStr $ prCId n, JS.EArray (map fromSyntaxForest args)]
-    fromSyntaxForest (FString s) = new "Lit" $ [JS.EStr s]
-    fromSyntaxForest (FInt i) = new "Lit" $ [JS.EInt $ fromIntegral i]
-    fromSyntaxForest (FFloat f) = new "Lit" $ [JS.EDbl f]
-
 lins2js :: Array FIndex (Array FPointPos FSymbol) -> JS.Expr
 lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls]
 
diff --git a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
index 7f5e0ba00..324f8be04 100644
--- a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
+++ b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
@@ -7,7 +7,7 @@ import GF.GFCC.Raw.AbsGFCCRaw
 import GF.Infra.PrintClass
 import GF.Data.Assoc
 import GF.Formalism.FCFG
-import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
+import GF.Formalism.Utilities
 import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
 
 import qualified Data.Array as Array
@@ -78,29 +78,21 @@ toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
     toFRule (App "rule"
               [n,                      
                App "cats" (rt:at),
-               App "R" ls]) = FRule name args res lins
+               App "R" ls]) = FRule fun prof args res lins
       where 
-        name = toFName n
+        (fun,prof) = toFName n
         args = lmap expToInt at
         res  = expToInt rt
         lins = mkArray [mkArray [toSymbol s | s <- l] | App "S" l <- ls]
 
-toFName :: RExp -> FName
-toFName (App "_A" [x]) = Name wildCId [Unify [expToInt x]]
-toFName (App f ts) = Name (mkCId f) (lmap toProfile ts)
+toFName :: RExp -> (CId,[Profile])
+toFName (App "_A" [x]) = (wildCId, [[expToInt x]])
+toFName (App f ts)     = (mkCId f, lmap toProfile ts)
     where
-      toProfile :: RExp -> Profile (SyntaxForest CId)
-      toProfile AMet = Unify []
-      toProfile (App "_A" [t]) = Unify [expToInt t]
-      toProfile (App "_U" ts) = Unify [expToInt t | App "_A" [t] <- ts]
-      toProfile t = Constant (toSyntaxForest t)
-
-      toSyntaxForest :: RExp -> SyntaxForest CId
-      toSyntaxForest AMet = FMeta
-      toSyntaxForest (App n ts) = FNode (mkCId n) [lmap toSyntaxForest ts]
-      toSyntaxForest (AStr s) = FString s
-      toSyntaxForest (AInt i) = FInt i
-      toSyntaxForest (AFlt f) = FFloat f
+      toProfile :: RExp -> Profile
+      toProfile AMet           = []
+      toProfile (App "_A" [t]) = [expToInt t]
+      toProfile (App "_U" ts)  = [expToInt t | App "_A" [t] <- ts]
 
 toSymbol :: RExp -> FSymbol
 toSymbol (App "P" [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
@@ -221,33 +213,23 @@ fromPInfo p = App "parser" [
         ]
 
 fromFRule :: FRule -> RExp
-fromFRule (FRule n args res lins) = 
-    App "rule" [fromFName n,
+fromFRule (FRule fun prof args res lins) = 
+    App "rule" [fromFName (fun,prof),
                 App "cats" (intToExp res:lmap intToExp args),
                 App "R" [App "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
                ]
 
-fromFName :: FName -> RExp
-fromFName n = case n of
-                Name f ps | f == wildCId -> fromProfile (head ps)
-                          | otherwise    -> App (prCId f) (lmap fromProfile ps)
+fromFName :: (CId,[Profile]) -> RExp
+fromFName (f,ps) | f == wildCId = fromProfile (head ps)
+                 | otherwise    = App (prCId f) (lmap fromProfile ps)
   where
-    fromProfile :: Profile (SyntaxForest CId) -> RExp
-    fromProfile (Unify []) = AMet
-    fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = App "_U" (lmap daughter args)
-    fromProfile (Constant forest) = fromSyntaxForest forest
+    fromProfile :: Profile -> RExp
+    fromProfile []   = AMet
+    fromProfile [x]  = daughter x
+    fromProfile args = App "_U" (lmap daughter args)
 
     daughter n = App "_A" [intToExp n]
 
-    fromSyntaxForest :: SyntaxForest CId -> RExp
-    fromSyntaxForest FMeta = AMet
-    -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = App (prCId n) (lmap fromSyntaxForest args)
-    fromSyntaxForest (FString s) = AStr s
-    fromSyntaxForest (FInt i) = AInt i
-    fromSyntaxForest (FFloat f) = AFlt f
-
 fromSymbol :: FSymbol -> RExp
 fromSymbol (FSymCat c l n) = App "P" [intToExp c, intToExp n, intToExp l]
 fromSymbol (FSymTok t) = AStr t