summaryrefslogtreecommitdiff
path: root/src/GF/Grammar/ReservedWords.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Grammar/ReservedWords.hs')
-rw-r--r--src/GF/Grammar/ReservedWords.hs44
1 files changed, 44 insertions, 0 deletions
diff --git a/src/GF/Grammar/ReservedWords.hs b/src/GF/Grammar/ReservedWords.hs
new file mode 100644
index 000000000..b440141d6
--- /dev/null
+++ b/src/GF/Grammar/ReservedWords.hs
@@ -0,0 +1,44 @@
+----------------------------------------------------------------------
+-- |
+-- Module : ReservedWords
+-- Maintainer : AR
+-- Stability : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:28 $
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- reserved words of GF. (c) Aarne Ranta 19\/3\/2002 under Gnu GPL.
+-- modified by Markus Forsberg 9\/4.
+-- modified by AR 12\/6\/2003 for GF2 and GFC
+-----------------------------------------------------------------------------
+
+module GF.Grammar.ReservedWords (isResWord, isResWordGFC) where
+
+import Data.List
+
+
+isResWord :: String -> Bool
+isResWord s = isInTree s resWordTree
+
+resWordTree :: BTree
+resWordTree =
+-- mapTree fst $ sorted2tree $ flip zip (repeat ()) $ sort allReservedWords
+-- nowadays obtained from LexGF.hs
+ B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N))))
+
+isResWordGFC :: String -> Bool
+isResWordGFC s = isInTree s $
+ B "of" (B "fun" (B "concrete" (B "cat" (B "abstract" N N) N) (B "flags" N N)) (B "lin" (B "in" N N) (B "lincat" N N))) (B "resource" (B "param" (B "oper" (B "open" N N) N) (B "pre" N N)) (B "table" (B "strs" N N) (B "variants" N N)))
+
+data BTree = N | B String BTree BTree deriving (Show)
+
+isInTree :: String -> BTree -> Bool
+isInTree x tree = case tree of
+ N -> False
+ B a left right
+ | x < a -> isInTree x left
+ | x > a -> isInTree x right
+ | x == a -> True
+