simplify GFCC syntax

4 files changed, 30 insertions, 44 deletions

diff --git a/src/GF/Canon/GFCC/AbsGFCC.hs b/src/GF/Canon/GFCC/AbsGFCC.hs
index af9f18088..ccb964689 100644
--- a/src/GF/Canon/GFCC/AbsGFCC.hs
+++ b/src/GF/Canon/GFCC/AbsGFCC.hs
@@ -47,24 +47,19 @@ data Term =
    R [Term]
  | P Term Term
  | S [Term]
- | K Tokn
- | V Integer
- | C Integer
+ | KS String
+ | KP [String] [Variant]
+ | V Int
+ | C Int
  | F CId
  | FV [Term]
- | W String Term
+ | W String [String]
  | RP Term Term
  | TM
  | L CId Term
  | BV CId
   deriving (Eq,Ord,Show)
 
-data Tokn =
-   KS String
- | KP [String] [Variant]
-  deriving (Eq,Ord,Show)
-
 data Variant =
    Var [String] [String]
   deriving (Eq,Ord,Show)
-
diff --git a/src/GF/Canon/GFCC/DataGFCC.hs b/src/GF/Canon/GFCC/DataGFCC.hs
index 43ce04166..746175e29 100644
--- a/src/GF/Canon/GFCC/DataGFCC.hs
+++ b/src/GF/Canon/GFCC/DataGFCC.hs
@@ -46,10 +46,9 @@ realize :: Term -> String
 realize trm = case trm of
   R ts     -> realize (ts !! 0)
   S ss     -> unwords $ Prelude.map realize ss
-  K t -> case t of
-    KS s -> s
-    KP s _ -> unwords s ---- prefix choice TODO
-  W s t    -> s ++ realize t
+  KS s     -> s
+  KP s _   -> unwords s ---- prefix choice TODO
+  W s ss   -> s ++ (ss !! 0)
   FV ts    -> realize (ts !! 0)  ---- other variants TODO
   RP _ r   -> realize r
   TM       -> "?"
@@ -59,9 +58,9 @@ linExp :: GFCC -> CId -> Exp -> Term
 linExp mcfg lang tree@(Tr at trees) = 
   case at of
     AC fun -> comp (Prelude.map lin trees) $ look fun
-    AS s   -> R [kks (show s)] -- quoted
-    AI i   -> R [kks (show i)]
-    AF d   -> R [kks (show d)]
+    AS s   -> R [KS (show s)] -- quoted
+    AI i   -> R [KS (show i)]
+    AF d   -> R [KS (show d)]
     AM     -> TM
  where
    lin  = linExp mcfg lang
@@ -72,19 +71,16 @@ exp0 :: Exp
 exp0 = Tr (AS "NO_PARSE") []
 
 term0 :: CId -> Term
-term0 (CId s) = R [kks ("#" ++ s ++ "#")]
-
-kks :: String -> Term
-kks = K . KS
+term0 (CId s) = R [KS ("#" ++ s ++ "#")]
 
 compute :: GFCC -> CId -> [Term] -> Term -> Term
 compute mcfg lang args = comp where
   comp trm = case trm of
     P r p  -> proj (comp r) (comp p) 
     RP i t -> RP (comp i) (comp t)
-    W s t  -> W s (comp t)
+    W s ss -> W s ss
     R ts   -> R $ Prelude.map comp ts
-    V i    -> idx args (fromInteger i)    -- already computed
+    V i    -> idx args i                  -- already computed
     F c    -> comp $ look c               -- not computed (if contains argvar)
     FV ts  -> FV $ Prelude.map comp ts
     S ts   -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts
@@ -94,23 +90,19 @@ compute mcfg lang args = comp where
 
   idx xs i = if i > length xs - 1 then trace "overrun !!\n" (last xs) else xs !! i 
 
-  proj r p = case (r,p) of
-    (_,     FV ts) -> FV $ Prelude.map (proj r) ts
-    (W s t, _)     -> kks (s ++ getString (proj t p))      
-    _              -> comp $ getField r (getIndex p)
-
-  getString t = case t of
-    K (KS s) -> s
-    _ -> trace ("ERROR in grammar compiler: string from "++ show t) "ERR"
+  proj r p = case p of
+    FV ts -> FV $ Prelude.map (proj r) ts
+    _     -> comp $ getField r (getIndex p)
 
   getIndex t =  case t of
-    C i    -> fromInteger i
+    C i    -> i
     RP p _ -> getIndex p
     TM     -> 0  -- default value for parameter
     _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 0
 
   getField t i = case t of
     R rs   -> idx rs i
+    W s ss -> KS (s ++ idx ss i)
     RP _ r -> getField r i
     TM     -> TM
     _ -> trace ("ERROR in grammar compiler: field from " ++ show t) t
diff --git a/src/GF/Canon/GFCC/GFCC.cf b/src/GF/Canon/GFCC/GFCC.cf
index 65657a259..5c8020905 100644
--- a/src/GF/Canon/GFCC/GFCC.cf
+++ b/src/GF/Canon/GFCC/GFCC.cf
@@ -21,20 +21,19 @@ define trA a = Tr a [] ;
 R.   Term     ::= "[" [Term] "]" ;          -- record/table
 P.   Term     ::= "(" Term "!" Term ")" ;   -- projection/selection
 S.   Term     ::= "(" [Term] ")" ;          -- sequence with ++
-K.   Term     ::= Tokn ;                    -- token
-V.   Term     ::= "$" Integer ;             -- argument
-C.   Term     ::= Integer ;                 -- parameter value/label
+KS.  Term     ::= String ;                  -- token
+KP.  Term     ::= "[" "pre" [String] "[" [Variant] "]" "]" ;
+V.   Term     ::= "$" Int ;                 -- argument
+C.   Term     ::= Int ;                     -- parameter value/label
 F.   Term     ::= CId ;                     -- global constant
 FV.  Term     ::= "[|" [Term] "|]" ;        -- free variation
-W.   Term     ::= "(" String "+" Term ")" ; -- prefix + suffix table
+W.   Term     ::= "(" String "+" [String] ")" ; -- prefix + suffix table
 RP.  Term     ::= "(" Term "@" Term ")";    -- record parameter alias
 TM.  Term     ::= "?" ;                     -- lin of metavariable
 
 L.   Term     ::= "(" CId "->" Term ")" ;   -- lambda abstracted table
 BV.  Term     ::= "#" CId ;                 -- lambda-bound variable
 
-KS.  Tokn     ::= String ;
-KP.  Tokn     ::= "[" "pre" [String] "[" [Variant] "]" "]" ;
 Var. Variant  ::= [String] "/" [String] ;
 
 
diff --git a/src/GF/Canon/GFCC/PrintGFCC.hs b/src/GF/Canon/GFCC/PrintGFCC.hs
index b8a98532e..1ef7cfbe3 100644
--- a/src/GF/Canon/GFCC/PrintGFCC.hs
+++ b/src/GF/Canon/GFCC/PrintGFCC.hs
@@ -69,6 +69,10 @@ prPrec :: Int -> Int -> Doc -> Doc
 prPrec i j = if j<i then parenth else id
 
 
+instance Print Int where
+  prt _ x = doc (shows x)
+
+
 instance Print Integer where
   prt _ x = doc (shows x)
 
@@ -153,7 +157,8 @@ instance Print Term where
    R terms -> prPrec i 0 (concatD [doc (showString "[") , prt 0 terms , doc (showString "]")])
    P term0 term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "!") , prt 0 term , doc (showString ")")])
    S terms -> prPrec i 0 (concatD [doc (showString "(") , prt 0 terms , doc (showString ")")])
-   K tokn -> prPrec i 0 (concatD [prt 0 tokn])
+   KS str -> prPrec i 0 (concatD [prt 0 str])
+   KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "[") , prt 0 variants , doc (showString "]") , doc (showString "]")])
    V n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
    C n -> prPrec i 0 (concatD [prt 0 n])
    F cid -> prPrec i 0 (concatD [prt 0 cid])
@@ -169,11 +174,6 @@ instance Print Term where
    [x] -> (concatD [prt 0 x])
    x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
 
-instance Print Tokn where
-  prt i e = case e of
-   KS str -> prPrec i 0 (concatD [prt 0 str])
-   KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "[") , prt 0 variants , doc (showString "]") , doc (showString "]")])
-
 
 instance Print Variant where
   prt i e = case e of