diff options
Diffstat (limited to 'src/GF/Grammar')
| -rw-r--r-- | src/GF/Grammar/AppPredefined.hs | 8 | ||||
| -rw-r--r-- | src/GF/Grammar/Grammar.hs | 2 | ||||
| -rw-r--r-- | src/GF/Grammar/LookAbs.hs | 15 |
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 |
