msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Added onTermIdents function.

Browse Source
This commit is contained in:
bringert
2005-03-07 16:50:00 +00:00
parent dcf87cd664
commit a4b8921544
1 changed files with 41 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
src/GF/Canon/CMacros.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:34 $ -- > CVS $Date: 2005/03/07 17:50:00 $
-- > CVS $Author: peb $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.21 $ -- > CVS $Revision: 1.22 $
-- --
-- Macros for building and analysing terms in GFC concrete syntax. -- Macros for building and analysing terms in GFC concrete syntax.
-- --
@@ -16,6 +16,7 @@
module CMacros where module CMacros where
import Ident
import AbsGFC import AbsGFC
import GFC import GFC
import qualified Ident as A ---- no need to qualif? 21/9 import qualified Ident as A ---- no need to qualif? 21/9
@@ -245,6 +246,43 @@ onTokens f t = case t of
K (KP ss vs) -> K (KP (map f ss) [Var (map f x) (map f y) | Var x y <- vs]) K (KP ss vs) -> K (KP (map f ss) [Var (map f x) (map f y) | Var x y <- vs])
_ -> composSafeOp (onTokens f) t _ -> composSafeOp (onTokens f) t
-- | Apply some function to all identifiers in a GFC term
onTermIdents :: (Ident -> Ident) -> Term -> Term
onTermIdents f t = case t of
Arg av -> Arg $ case av of
A i x -> A (f i) x
AB i x y -> AB (f i) x y
I ci -> I (fc ci)
Con ci ts -> Con (fc ci) (map (onTermIdents f) ts)
LI i -> LI (f i)
R as -> R [Ass (fl l) (onTermIdents f t) | Ass l t <- as]
P t l -> P (onTermIdents f t) (fl l)
T ct cs -> T (fct ct) [Cas (map fp ps) (onTermIdents f t) | Cas ps t <- cs]
V ct ts -> V (fct ct) (map (onTermIdents f) ts)
S t1 t2 -> S (onTermIdents f t1) (onTermIdents f t2)
C t1 t2 -> C (onTermIdents f t1) (onTermIdents f t2)
FV ts -> FV (map (onTermIdents f) ts)
_ -> t
where
fc :: CIdent -> CIdent
fc (CIQ i1 i2) = CIQ (f i1) (f i2)
fl :: Label -> Label
fl l = case l of
L i -> L (f i)
_ -> l
fct :: CType -> CType
fct ct = case ct of
RecType ls -> RecType [ Lbg (fl l) (fct ct) | Lbg l ct <- ls ]
Table t1 t2 -> Table (fct t1) (fct t2)
Cn ci -> Cn (fc ci)
_ -> ct
fp :: Patt -> Patt
fp p = case p of
PC ci ps -> PC (fc ci) (map fp ps)
PV i -> PV (f i)
PR ps -> PR [PAss (fl l) (fp p) | PAss l p <- ps]
_ -> p
-- | to define compositional term functions -- | to define compositional term functions
composSafeOp :: (Term -> Term) -> Term -> Term composSafeOp :: (Term -> Term) -> Term -> Term