1
0
forked from GitHub/gf-core

remove the obsolete GF.Infra.PrintClass

This commit is contained in:
krasimir
2009-03-13 07:00:04 +00:00
parent d1276ee52b
commit bae62cf7c2
4 changed files with 1 additions and 118 deletions

View File

@@ -1,61 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module : RemoveLiT
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:21:45 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.6 $
--
-- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003
--
-- What the program does is replace the occurrences of Lin C with the actual
-- definition T given in lincat C = T ; with {s : Str} if no lincat is found.
-- The procedure is uncertain, if T contains another Lin.
-----------------------------------------------------------------------------
module GF.Compile.RemoveLiT (removeLiT) where
import GF.Grammar.Grammar
import GF.Infra.Ident
import GF.Infra.Modules
import GF.Grammar.Macros
import GF.Grammar.Lookup
import GF.Grammar.Predef
import GF.Data.Operations
import Control.Monad
removeLiT :: SourceGrammar -> Err SourceGrammar
removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)
remlModule :: SourceGrammar -> SourceModule -> Err SourceModule
remlModule gr mi@(name,mo) = do
js1 <- mapMTree (remlResInfo gr) (jments mo)
return (name,mo{jments = js1})
remlResInfo :: SourceGrammar -> (Ident,Info) -> Err Info
remlResInfo gr (i,info) = case info of
ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
CncFun mt ptr ppr -> liftM2 (CncFun mt) (ren ptr) (ren ppr)
_ -> return info
where
ren = remlPerh gr
remlPerh gr pt = case pt of
Yes t -> liftM Yes $ remlTerm gr t
_ -> return pt
remlTerm :: SourceGrammar -> Term -> Err Term
remlTerm gr trm = case trm of
LiT c -> look c >>= remlTerm gr
_ -> composOp (remlTerm gr) trm
where
look c = err (const $ return defLinType) return $ lookupLincat gr m c
m = case [cnc | (cnc,m) <- modules gr, isModCnc m] of
cnc:_ -> cnc -- actually there is always exactly one
_ -> cCNC

View File

@@ -1,51 +0,0 @@
module GF.Infra.PrintClass where
import Data.List (intersperse)
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"

View File

@@ -9,7 +9,6 @@ module GF.Speech.CFG where
import GF.Data.Utilities import GF.Data.Utilities
import PGF.CId import PGF.CId
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.PrintClass
import GF.Data.Relation import GF.Data.Relation
import Control.Monad import Control.Monad

View File

@@ -15,14 +15,13 @@ module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
, makeNonRecursiveSRG , makeNonRecursiveSRG
, getSpeechLanguage , getSpeechLanguage
, isExternalCat , isExternalCat
, lookupFM_, prtS , lookupFM_
) where ) where
import GF.Data.Operations import GF.Data.Operations
import GF.Data.Utilities import GF.Data.Utilities
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.PrintClass
import GF.Speech.CFG import GF.Speech.CFG
import GF.Speech.PGFToCFG import GF.Speech.PGFToCFG
import GF.Data.Relation import GF.Data.Relation
@@ -204,6 +203,3 @@ lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt
lookupFM_ fm k = Map.findWithDefault err k fm lookupFM_ fm k = Map.findWithDefault err k fm
where err = error $ "Key not found: " ++ show k where err = error $ "Key not found: " ++ show k
++ "\namong " ++ show (Map.keys fm) ++ "\namong " ++ show (Map.keys fm)
prtS :: Print a => a -> ShowS
prtS = showString . prt