summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/AppPredefined.hs8
-rw-r--r--src/GF/Grammar/Grammar.hs2
-rw-r--r--src/GF/Grammar/LookAbs.hs15
3 files changed, 24 insertions, 1 deletions
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index f59c910b0..14f35a1d4 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -26,6 +26,7 @@ appPredefined t = case t of
("tk", EInt i, K s) -> K (take (max 0 (length s - i)) s)
("dp", EInt i, K s) -> K (drop (max 0 (length s - i)) s)
("eqStr",K s, K t) -> if s == t then predefTrue else predefFalse
+ ("occur",K s, K t) -> if substring s t then predefTrue else predefFalse
("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse
("plus", EInt i, EInt j) -> EInt $ i+j
("show", _, t) -> K $ prt t
@@ -49,3 +50,10 @@ str2tag s = case s of
predefTrue = Q (IC "Predef") (IC "PTrue")
predefFalse = Q (IC "Predef") (IC "PFalse")
+
+substring :: String -> String -> Bool
+substring s t = case (s,t) of
+ (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds
+ ([],_) -> True
+ _ -> False
+
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index ee018791a..a2978d6b3 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -26,7 +26,7 @@ type SourceCnc = Module Ident Option Info
data Info =
AbsCat (Perh Context) (Perh [Term]) -- constructors; must be Id or QId
| AbsFun (Perh Type) (Perh Term) -- Yes f = canonical
- | AbsTrans Ident
+ | AbsTrans Term
-- judgements in resource
| ResParam (Perh [Param])
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 8400d9af5..43a8c580a 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -48,6 +48,21 @@ lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
_ -> prtBad "unknown category" c
_ -> Bad $ prt m +++ "is not an abstract module"
+-- lookup for transfer function: transfer-module-name, category name
+
+lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term
+lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
+ mi <- lookupModule gr m
+ case mi of
+ ModMod mo -> do
+ info <- lookupInfo mo c
+ case info of
+ C.AbsTrans t -> return t
+ C.AnyInd _ n -> lookupTransfer gr n c
+ _ -> prtBad "cannot transfer function for" c
+ _ -> Bad $ prt m +++ "is not a transfer module"
+
+
---- should be revised (20/9/2003)
isPrimitiveFun :: GFCGrammar -> Fun -> Bool
isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of