forked from GitHub/gf-core
remove the obsolete GF.Infra.PrintClass
This commit is contained in:
@@ -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
|
|
||||||
@@ -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"
|
|
||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
|
||||||
|
|||||||
Reference in New Issue
Block a user