summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Compile/RemoveLiT.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src-3.0/GF/Compile/RemoveLiT.hs')
-rw-r--r--src-3.0/GF/Compile/RemoveLiT.hs64
1 files changed, 0 insertions, 64 deletions
diff --git a/src-3.0/GF/Compile/RemoveLiT.hs b/src-3.0/GF/Compile/RemoveLiT.hs
deleted file mode 100644
index d06b80400..000000000
--- a/src-3.0/GF/Compile/RemoveLiT.hs
+++ /dev/null
@@ -1,64 +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 -> (Ident,SourceModInfo) -> Err (Ident,SourceModInfo)
-remlModule gr mi@(name,mod) = case mod of
- ModMod mo -> do
- js1 <- mapMTree (remlResInfo gr) (jments mo)
- let mod2 = ModMod $ mo {jments = js1}
- return $ (name,mod2)
- _ -> return mi
-
-remlResInfo :: SourceGrammar -> (Ident,Info) -> Err (Ident,Info)
-remlResInfo gr mi@(i,info) = case info of
- ResOper pty ptr -> liftM ((,) i) $ liftM2 ResOper (ren pty) (ren ptr)
- CncCat pty ptr ppr -> liftM ((,) i) $ liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
- CncFun mt ptr ppr -> liftM ((,) i) $ liftM2 (CncFun mt) (ren ptr) (ren ppr)
- _ -> return mi
- 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,ModMod m) <- modules gr, isModCnc m] of
- cnc:_ -> cnc -- actually there is always exactly one
- _ -> cCNC