refactored FCFG parsing to fit in GFCC shell

18 files changed, 197 insertions, 161 deletions

diff --git a/src/GF/Canon/GFCC/FCFGParsing.hs b/src/GF/Canon/GFCC/FCFGParsing.hs
index f9a838417..e5258764c 100644
--- a/src/GF/Canon/GFCC/FCFGParsing.hs
+++ b/src/GF/Canon/GFCC/FCFGParsing.hs
@@ -1,8 +1,8 @@
-module GF.Canon.GFCC.FCFGParsing where
+module GF.Canon.GFCC.FCFGParsing (parserLang) where
 
 import GF.Canon.GFCC.DataGFCC
 import GF.Canon.GFCC.AbsGFCC
-import GF.Conversion.SimpleToFCFG (convertGrammar)
+import GF.Conversion.SimpleToFCFG (convertGrammarCId,FCat(..))
 
 --import GF.System.Tracing 
 --import GF.Infra.Print
@@ -20,8 +20,9 @@ import GF.Conversion.SimpleToFCFG (convertGrammar)
 import GF.Data.SortedList 
 import GF.Data.Assoc
 import GF.Formalism.Utilities --(forest2trees)
+import qualified GF.Data.Operations as Op
 
---import GF.Conversion.Types
+import GF.Conversion.FTypes
 
 import GF.Formalism.FCFG
 --import qualified GF.Formalism.GCFG as G
@@ -32,16 +33,15 @@ import GF.Formalism.FCFG
 import qualified GF.Parsing.FCFG as PF
 --import qualified GF.Parsing.CFG as PC
 import GF.Canon.GFCC.ErrM
+import GF.Infra.PrintClass
 
+--convertGrammarCId :: Grammar -> [(CId,FGrammar)]
 
---convertGrammar :: Grammar -> [(Ident,FGrammar)]
+parserLang :: GFCC -> CId -> CFCat -> [CFTok] -> Err [Exp]
+parserLang mgr lang = parse info where
+  fcfgs = convertGrammarCId mgr
+  info  = buildPInfo $ maybe (error "no parser") id $ lookup lang fcfgs
 
---import qualified GF.Parsing.GFC as New
---checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
--- algorithm "f"
--- strategy "bottomup"
-
-type Token = String ----
 type CFTok = String ----
 type CFCat = CId ----
 type Fun = CId ----
@@ -54,6 +54,16 @@ wordsCFTok = return ----
 
 type FCFPInfo = PF.FCFPInfo FCat FName Token
 
+buildPInfo :: FGrammar -> FCFPInfo
+buildPInfo fcfg = PF.buildFCFPInfo grammarLexer fcfg where
+  grammarLexer s =
+      case reads s of
+        [(n,"")] -> (fcatInt, SInt (n::Integer))
+        _        -> case reads s of
+                      [(f,"")] -> (fcatFloat, SFloat  (f::Double))
+                      _        -> (fcatString,SString s)
+
+
 -- main parsing function
 
 parse :: 
@@ -65,7 +75,7 @@ parse ::
       [CFTok] ->        -- ^ input tokens
       Err [Exp]         -- ^ resulting GF terms
 
-parse pinfo startCat inString = 
+parse pinfo startCat inString = e2e $
 
     do let inTokens = inputMany (map wordsCFTok inString)
        forests <- selectParser pinfo startCat inTokens
@@ -107,7 +117,7 @@ cnv_forests2 (FFloat  x)   = FFloat  x
 -- parse trees to GFCC terms
 
 tree2term :: SyntaxTree Fun -> Exp
-tree2term (TNode f ts) = Tr (AC (CId f)) (map tree2term ts)
+tree2term (TNode f ts) = Tr (AC f) (map tree2term ts)
 {- ----
 tree2term (TString  s) = Macros.string2term s
 tree2term (TInt     n) = Macros.int2term    n
@@ -122,7 +132,7 @@ tree2term (TMeta)      = Macros.mkMeta 0
 -- simplest implementation
 applyProfileToForest :: SyntaxForest Name -> [SyntaxForest Fun]
 applyProfileToForest (FNode name@(Name fun profile) children) 
-    | isCoercion name = concat chForests
+    | isCoercionF name = concat chForests
     | otherwise       = [ FNode fun chForests | not (null chForests) ]
     where chForests   = concat [ applyProfileM unifyManyForests profile forests |
 				 forests0 <- children,
@@ -132,40 +142,10 @@ applyProfileToForest (FInt    n) = [FInt    n]
 applyProfileToForest (FFloat  f) = [FFloat  f]
 applyProfileToForest (FMeta)     = [FMeta]
 
-
---------------------- From parsing types ------------------------------
-
--- * fast nonerasing MCFG
-
-type FIndex   = Int
-type FPath    = [FIndex]
-type FName    = NameProfile CId
-type FGrammar = FCFGrammar FCat FName Token
-type FRule    = FCFRule    FCat FName Token
-data FCat     = FCat  {-# UNPACK #-} !Int CId [FPath] [(FPath,FIndex)]
-
-initialFCat :: CId -> FCat
-initialFCat cat = FCat 0 cat [] []
-
-fcatString = FCat (-1) (CId "String") [[0]] []
-fcatInt    = FCat (-2) (CId "Int")    [[0]] []
-fcatFloat  = FCat (-3) (CId "Float")  [[0]] []
-
-fcat2cid :: FCat -> CId
-fcat2cid (FCat _ c _ _) = c
-
-instance Eq FCat where
-  (FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
-
-instance Ord FCat where
-  compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
-
-
-
 ---
 
-isCoercion :: Name -> Bool
-isCoercion (Name fun [Unify [0]]) = False -- isWildIdent fun
-isCoercion _ = False
+e2e :: Op.Err a -> Err a
+e2e e = case e of
+  Op.Ok v -> Ok v
+  Op.Bad s -> Bad s
 
-type Name = NameProfile Fun
diff --git a/src/GF/Canon/GFCC/GFCCAPI.hs b/src/GF/Canon/GFCC/GFCCAPI.hs
index e815697d7..5630f97ea 100644
--- a/src/GF/Canon/GFCC/GFCCAPI.hs
+++ b/src/GF/Canon/GFCC/GFCCAPI.hs
@@ -21,6 +21,7 @@ import GF.Canon.GFCC.AbsGFCC
 import GF.Canon.GFCC.ParGFCC
 import GF.Canon.GFCC.PrintGFCC
 import GF.Canon.GFCC.ErrM
+import GF.Canon.GFCC.FCFGParsing
 --import GF.Data.Operations
 --import GF.Infra.UseIO
 import qualified Data.Map as Map
@@ -70,7 +71,9 @@ file2grammar f =
 linearize mgr lang = GF.Canon.GFCC.DataGFCC.linearize mgr (CId lang)
 
 
-parse mgr lang cat s = [] 
+parse mgr lang cat s = 
+  err error id $ parserLang mgr (CId lang) (CId cat) (words s)
+
 {-
   map tree2exp . 
   errVal [] . 
diff --git a/src/GF/Conversion/FTypes.hs b/src/GF/Conversion/FTypes.hs
new file mode 100644
index 000000000..6538b04cd
--- /dev/null
+++ b/src/GF/Conversion/FTypes.hs
@@ -0,0 +1,64 @@
+module GF.Conversion.FTypes where
+
+import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
+import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..))
+
+import GF.Formalism.FCFG
+import GF.Formalism.Utilities
+import GF.Infra.PrintClass
+import GF.Data.Assoc
+
+import Control.Monad (foldM)
+import Data.Array
+
+----------------------------------------------------------------------
+-- * basic (leaf) types
+
+-- ** input tokens
+
+---- type Token = String ---- inlined in FGrammar and FRule
+
+
+----------------------------------------------------------------------
+-- * fast nonerasing MCFG
+
+type FIndex   = Int
+type FPath    = [FIndex]
+type FName    = NameProfile AbsGFCC.CId
+type FGrammar = FCFGrammar FCat FName String
+type FRule    = FCFRule    FCat FName String
+data FCat     = FCat  {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
+
+initialFCat :: AbsGFCC.CId -> FCat
+initialFCat cat = FCat 0 cat [] []
+
+fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
+fcatInt    = FCat (-2) (AbsGFCC.CId "Int")    [[0]] []
+fcatFloat  = FCat (-3) (AbsGFCC.CId "Float")  [[0]] []
+
+fcat2cid :: FCat -> AbsGFCC.CId
+fcat2cid (FCat _ c _ _) = c
+
+instance Eq FCat where
+  (FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
+
+instance Ord FCat where
+  compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
+
+instance Print AbsGFCC.CId where
+  prt (AbsGFCC.CId s) = s
+
+isCoercionF :: FName -> Bool
+isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.CId "_"
+isCoercionF _ = False
+
+
+----------------------------------------------------------------------
+-- * pretty-printing
+
+instance Print FCat where
+    prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++ 
+			             prtSep ";" ([prt path                    |  path       <- rcs] ++
+			                         [prt path ++ "=" ++ prt term | (path,term) <- tcs])
+			                 ++ "}"
+
diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index 5f26167e7..5abfe17c0 100644
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -25,6 +25,7 @@ import GF.Formalism.SimpleGFC (decl2cat)
 import GF.Formalism.CFG (CFRule(..))
 import GF.Formalism.Utilities (symbol, name2fun)
 import GF.Conversion.Types
+import GF.Conversion.FTypes
 
 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
diff --git a/src/GF/Conversion/SimpleToFCFG.hs b/src/GF/Conversion/SimpleToFCFG.hs
index e0e639800..7b003ecd9 100644
--- a/src/GF/Conversion/SimpleToFCFG.hs
+++ b/src/GF/Conversion/SimpleToFCFG.hs
@@ -13,17 +13,17 @@
 
 
 module GF.Conversion.SimpleToFCFG
-    (convertGrammar) where
+    (convertGrammar,convertGrammarCId,FCat(..)) where
 
 import GF.System.Tracing
-import GF.Infra.Print
+import GF.Infra.PrintClass
 import GF.Infra.Ident
 
 import Control.Monad
 
 import GF.Formalism.Utilities
 import GF.Formalism.FCFG
-import GF.Conversion.Types
+import GF.Conversion.FTypes
 import GF.Canon.GFCC.AbsGFCC
 import GF.Canon.GFCC.DataGFCC
 
@@ -40,17 +40,27 @@ import Data.Maybe
 ----------------------------------------------------------------------
 -- main conversion function
 
-convertGrammar :: Grammar -> [(Ident,FGrammar)]
-convertGrammar g@(Grm hdr (Abs abs_defs) cncs) = [(i2i cncname,convert abs_defs conc) | cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
+type FToken = String
+
+convertGrammar :: Grammar -> [(Ident,FCFGrammar FCat FName FToken)]
+convertGrammar g = [(IC c, f) | (CId c,f) <- convertGrammarCId (mkGFCC g)]
+
+-- this is more native for GFCC
+
+convertGrammarCId :: GFCC -> [(CId,FCFGrammar FCat FName FToken)]
+convertGrammarCId gfcc = [(cncname,convert abs_defs conc) | 
+    cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
   where
-    gfcc = mkGFCC g
 
-    i2i (CId i) = IC i
+    abs_defs = Map.assocs (funs (abstract gfcc))
 
-    convert :: [AbsDef] -> TermMap -> FGrammar
+    convert :: [(CId,Type)] -> TermMap -> FGrammar
     convert abs_defs cnc_defs = getFRules (loop frulesEnv)
       where
-        srules = [(XRule id args res (map findLinType args) (findLinType res) term) | Fun id (Typ args res) exp <- abs_defs, term <- Map.lookup id cnc_defs]
+        srules = [
+          (XRule id args res (map findLinType args) (findLinType res) term) | 
+            (id, Typ args res) <- abs_defs, 
+            term <- Map.lookup id cnc_defs]
         
         findLinType (CId id) = fromJust (Map.lookup (CId ("__"++id)) cnc_defs)
 
@@ -119,7 +129,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
 type CnvMonad a = BacktrackM Env a
 
 type Env     = (FCat, [(FCat,[FPath])], Term, [Term])
-type LinRec  = [(FPath, [Symbol (FPath, FIndex, Int) Token])]
+type LinRec  = [(FPath, [Symbol (FPath, FIndex, Int) FToken])]
 
 type TermMap = Map.Map CId Term
 
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index 6285468d5..1a8d80c5d 100644
--- a/src/GF/Conversion/Types.hs
+++ b/src/GF/Conversion/Types.hs
@@ -14,6 +14,8 @@
 
 module GF.Conversion.Types where
 
+---import GF.Conversion.FTypes
+
 import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
 import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..))
 import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..))
@@ -110,31 +112,8 @@ mcat2scat = ecat2scat . mcat2ecat
 ----------------------------------------------------------------------
 -- * fast nonerasing MCFG
 
-type FIndex   = Int
-type FPath    = [FIndex]
-type FName    = NameProfile AbsGFCC.CId
-type FGrammar = FCFGrammar FCat FName Token
-type FRule    = FCFRule    FCat FName Token
-data FCat     = FCat  {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
-
-initialFCat :: AbsGFCC.CId -> FCat
-initialFCat cat = FCat 0 cat [] []
-
-fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
-fcatInt    = FCat (-2) (AbsGFCC.CId "Int")    [[0]] []
-fcatFloat  = FCat (-3) (AbsGFCC.CId "Float")  [[0]] []
-
-fcat2cid :: FCat -> AbsGFCC.CId
-fcat2cid (FCat _ c _ _) = c
-
-instance Eq FCat where
-  (FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
-
-instance Ord FCat where
-  compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
+---- moved to FTypes by AR 20/9/2007
 
-instance Print AbsGFCC.CId where
-  prt (AbsGFCC.CId s) = s
 
 ----------------------------------------------------------------------
 -- * CFG
@@ -163,9 +142,5 @@ instance Print MCat where
 instance Print CCat where
     prt (CCat cat label) = prt cat ++ prt label
 
-instance Print FCat where
-    prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++ 
-			             prtSep ";" ([prt path                    |  path       <- rcs] ++
-			                         [prt path ++ "=" ++ prt term | (path,term) <- tcs])
-			                 ++ "}"
+---- instance Print FCat where ---- FCat
 
diff --git a/src/GF/FCFG/ToFCFG.hs b/src/GF/FCFG/ToFCFG.hs
index a5ecda214..790993487 100644
--- a/src/GF/FCFG/ToFCFG.hs
+++ b/src/GF/FCFG/ToFCFG.hs
@@ -11,7 +11,7 @@ module GF.FCFG.ToFCFG (printFGrammar) where
 
 import GF.Formalism.FCFG
 import GF.Formalism.SimpleGFC
-import GF.Conversion.Types
+import GF.Conversion.FTypes
 import GF.Infra.Ident
 import qualified GF.FCFG.AbsFCFG as F
 
@@ -28,22 +28,23 @@ import GF.Formalism.GCFG
 
 import GF.Infra.Print
 
+type FToken = String
 
 -- this is the main function used
-printFGrammar :: FCFGrammar FCat FName Token -> String
+printFGrammar :: FCFGrammar FCat FName FToken -> String
 printFGrammar = undefined {- printTree . fgrammar
 
-fgrammar :: FCFGrammar FCat Name Token -> F.FGrammar
+fgrammar :: FCFGrammar FCat Name FToken -> F.FGrammar
 fgrammar = F.FGr . map frule
 
-frule :: FCFRule FCat Name Token -> F.FRule
+frule :: FCFRule FCat Name FToken -> F.FRule
 frule (FRule ab rhs) = 
   F.FR (abstract ab) [[fsymbol sym | (_,sym) <- assocs syms] | (_,syms) <- assocs rhs]
 
 abstract :: Abstract FCat Name -> F.Abstract
 abstract (Abs cat cats n) = F.Abs (fcat cat) (map fcat cats) (name n)
 
-fsymbol :: FSymbol FCat Token -> F.FSymbol
+fsymbol :: FSymbol FCat FToken -> F.FSymbol
 fsymbol fs = case fs of
   FSymCat fc i j -> F.FSymCat (fcat fc) (toInteger i) (toInteger j)
   FSymTok s -> F.FSymTok s
@@ -56,7 +57,7 @@ fcat (FCat i id ps pts) =
 name :: Name -> F.Name
 name (Name id profs) = F.Nm (ident id) (map profile profs)
 
-pathel :: Either C.Label (Term SCat Token) -> F.PathEl
+pathel :: Either C.Label (Term SCat FToken) -> F.PathEl
 pathel lt = case lt of
   Left lab -> F.PLabel $ label lab
   Right trm -> F.PTerm $ term trm
@@ -76,7 +77,7 @@ forest f = case f of
   FInt i -> F.FInt i
   FFloat d -> F.FFloat d
 
-term :: Term SCat Token -> F.Term
+term :: Term SCat FToken -> F.Term
 term tr = case tr of
   Arg i id p -> F.Arg (toInteger i) (ident id) (path p)
   Rec rs -> F.Rec [F.Ass (label l) (term t) | (l,t) <- rs]
diff --git a/src/GF/Formalism/FCFG.hs b/src/GF/Formalism/FCFG.hs
index 2be442a29..e8e1f52e8 100644
--- a/src/GF/Formalism/FCFG.hs
+++ b/src/GF/Formalism/FCFG.hs
@@ -14,9 +14,9 @@ import Data.List (groupBy)
 import Data.Array
 
 import GF.Formalism.Utilities
-import GF.Formalism.GCFG
+--import GF.Formalism.GCFG
 
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 
 ------------------------------------------------------------
diff --git a/src/GF/Formalism/GCFG.hs b/src/GF/Formalism/GCFG.hs
index bfe90bac9..5242081c7 100644
--- a/src/GF/Formalism/GCFG.hs
+++ b/src/GF/Formalism/GCFG.hs
@@ -16,7 +16,7 @@ module GF.Formalism.GCFG where
 import GF.Formalism.Utilities (SyntaxChart)
 import GF.Data.Assoc (assocMap, accumAssoc)
 import GF.Data.SortedList (nubsort, groupPairs)
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 ----------------------------------------------------------------------
 
diff --git a/src/GF/Formalism/MCFG.hs b/src/GF/Formalism/MCFG.hs
index 52f577667..e6aa965e7 100644
--- a/src/GF/Formalism/MCFG.hs
+++ b/src/GF/Formalism/MCFG.hs
@@ -19,7 +19,7 @@ import Data.List (groupBy)
 import GF.Formalism.Utilities
 import GF.Formalism.GCFG
 
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 
 ------------------------------------------------------------
diff --git a/src/GF/Formalism/Utilities.hs b/src/GF/Formalism/Utilities.hs
index 633064692..5d6c5854e 100644
--- a/src/GF/Formalism/Utilities.hs
+++ b/src/GF/Formalism/Utilities.hs
@@ -22,7 +22,7 @@ import GF.Data.SortedList
 import GF.Data.Assoc
 import GF.Data.Utilities (sameLength, foldMerge, splitBy)
 
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 ------------------------------------------------------------
 -- * symbols
diff --git a/src/GF/Infra/Print.hs b/src/GF/Infra/Print.hs
index fe3ffa207..c4a310c29 100644
--- a/src/GF/Infra/Print.hs
+++ b/src/GF/Infra/Print.hs
@@ -12,16 +12,14 @@
 -----------------------------------------------------------------------------
 
 module GF.Infra.Print
-    (Print(..),
-     prtBefore, prtAfter, prtSep, 
-     prtBeforeAfter, prtPairList,
-     prIO
+    (module GF.Infra.PrintClass
     ) where
 
 -- haskell modules:
-import Data.List (intersperse)
 import Data.Char (toUpper)
 -- gf modules:
+
+import GF.Infra.PrintClass
 import GF.Data.Operations (Err(..))
 import GF.Infra.Ident (Ident(..))
 import GF.Canon.AbsGFC
@@ -31,59 +29,6 @@ import qualified GF.Canon.PrintGFC as P
 
 ------------------------------------------------------------
 
-prtBefore :: Print a => String -> [a] -> String
-prtBefore before = prtBeforeAfter before ""
-
-prtAfter :: Print a => String -> [a] -> String
-prtAfter after = prtBeforeAfter "" after
-
-prtSep :: Print a => String -> [a] -> String
-prtSep sep = concat . intersperse sep . map prt
-
-prtBeforeAfter :: Print a => String -> String -> [a] -> String
-prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
-
-prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
-prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
-
-prIO :: Print a => a -> IO ()
-prIO = putStr . prt
-
-class Print a where
-    prt :: a -> String
-    prtList :: [a] -> String
-    prtList as = "[" ++ prtSep "," as ++ "]"
-
-instance Print a => Print [a] where
-    prt = prtList
-
-instance (Print a, Print b) => Print (a, b) where
-    prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
-
-instance (Print a, Print b, Print c) => Print (a, b, c) where
-    prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
-
-instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
-    prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
-
-instance Print Char where
-    prt = return
-    prtList = id
-
-instance Print Int where
-    prt = show
-
-instance Print Integer where
-    prt = show
-
-instance Print a => Print (Maybe a) where
-    prt (Just a) = prt a
-    prt Nothing  = "Nothing"
-
-instance Print a => Print (Err a) where
-    prt (Ok a) = prt a
-    prt (Bad str) = str
-
 ----------------------------------------------------------------------
 
 instance Print Ident where
diff --git a/src/GF/Infra/PrintClass.hs b/src/GF/Infra/PrintClass.hs
new file mode 100644
index 000000000..93d7366b6
--- /dev/null
+++ b/src/GF/Infra/PrintClass.hs
@@ -0,0 +1,56 @@
+module GF.Infra.PrintClass where
+
+import Data.List (intersperse)
+import GF.Data.Operations (Err(..))
+
+class Print a where
+    prt :: a -> String
+    prtList :: [a] -> String
+    prtList as = "[" ++ prtSep "," as ++ "]"
+
+prtSep :: Print a => String -> [a] -> String
+prtSep sep = concat . intersperse sep . map prt
+
+prtBefore :: Print a => String -> [a] -> String
+prtBefore before = prtBeforeAfter before ""
+
+prtAfter :: Print a => String -> [a] -> String
+prtAfter after = prtBeforeAfter "" after
+
+prtBeforeAfter :: Print a => String -> String -> [a] -> String
+prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
+
+prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
+prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
+prIO :: Print a => a -> IO ()
+prIO = putStr . prt
+
+instance Print a => Print [a] where
+    prt = prtList
+
+instance (Print a, Print b) => Print (a, b) where
+    prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
+
+instance (Print a, Print b, Print c) => Print (a, b, c) where
+    prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
+
+instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
+    prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
+
+instance Print Char where
+    prt = return
+    prtList = id
+
+instance Print Int where
+    prt = show
+
+instance Print Integer where
+    prt = show
+
+instance Print a => Print (Maybe a) where
+    prt (Just a) = prt a
+    prt Nothing  = "Nothing"
+
+instance Print a => Print (Err a) where
+    prt (Ok a) = prt a
+    prt (Bad str) = str
diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs
index 404bb9950..9309dc78c 100644
--- a/src/GF/Parsing/FCFG.hs
+++ b/src/GF/Parsing/FCFG.hs
@@ -18,7 +18,7 @@ import GF.Formalism.MCFG
 import GF.Parsing.FCFG.PInfo
 
 import qualified GF.Parsing.FCFG.Active as Active
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 ----------------------------------------------------------------------
 -- parsing
diff --git a/src/GF/Parsing/FCFG/Active.hs b/src/GF/Parsing/FCFG/Active.hs
index 48c637e18..243fc993c 100644
--- a/src/GF/Parsing/FCFG/Active.hs
+++ b/src/GF/Parsing/FCFG/Active.hs
@@ -20,7 +20,7 @@ import GF.Formalism.MCFG(Lin(..))
 import GF.Formalism.Utilities
 
 import GF.Infra.Ident
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 import GF.Parsing.FCFG.Range
 import GF.Parsing.FCFG.PInfo
diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs
index c87f0b15c..0105bf24f 100644
--- a/src/GF/Parsing/FCFG/PInfo.hs
+++ b/src/GF/Parsing/FCFG/PInfo.hs
@@ -10,7 +10,7 @@
 module GF.Parsing.FCFG.PInfo where
 
 import GF.System.Tracing
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 import GF.Formalism.Utilities
 import GF.Formalism.GCFG
diff --git a/src/GF/Parsing/FCFG/Range.hs b/src/GF/Parsing/FCFG/Range.hs
index 6badf4252..24674f58b 100644
--- a/src/GF/Parsing/FCFG/Range.hs
+++ b/src/GF/Parsing/FCFG/Range.hs
@@ -14,7 +14,7 @@ module GF.Parsing.FCFG.Range
 
 -- GF modules
 import GF.Formalism.Utilities
-import GF.Infra.Print
+import GF.Infra.PrintClass
 
 ------------------------------------------------------------
 -- ranges as single pairs
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index e1d0d298b..6d6c662c0 100644
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -32,6 +32,7 @@ import GF.Data.SortedList
 import GF.Data.Assoc
 import GF.Formalism.Utilities
 import GF.Conversion.Types
+import GF.Conversion.FTypes
 
 import qualified GF.Formalism.GCFG as G
 import qualified GF.Formalism.SimpleGFC as S