More sharing of reserved words in GF and GFC lexers. Added GF lexer alex file.

src/GF/Source/LexGF.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS -fglasgow-exts -cpp #-}
-{-# LINE 3 "LexGF.x" #-}
+{-# LINE 4 "LexGF.x" #-}
 module LexGF where
-
+import SharedString -- H
 import ErrM
 
 #if __GLASGOW_HASKELL__ >= 503
@@ -30,18 +30,18 @@ alex_deflt :: AlexAddr
 alex_deflt = AlexA# "\x15\x00\xff\xff\x03\x00\x03\x00\xff\xff\xff\xff\x0b\x00\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x14\x00\xff\xff\xff\xff\xff\xff\x19\x00\x19\x00\xff\xff\xff\xff"#
 
 alex_accept = listArray (0::Int,27) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[],[],[],[(AlexAcc (alex_action_7))]]
-{-# LINE 34 "LexGF.x" #-}
+{-# LINE 35 "LexGF.x" #-}
 
 tok f p s = f p s
 
 data Tok =
-   TS String     -- reserved words
- | TL String     -- string literals
+   TS !String     -- reserved words    -- H
+ | TL !String     -- string literals   -- H
  | TI String     -- integer literals
- | TV String     -- identifiers
+ | TV !String     -- identifiers       -- H
  | TD String     -- double precision float literals
  | TC String     -- character literals
- | T_LString String
+ | T_LString !String                   -- H
 
  deriving (Eq,Show,Ord)
 
@@ -67,20 +67,18 @@ prToken t = case t of
 
   _ -> show t
 
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
 eitherResIdent :: (String -> Tok) -> String -> Tok
-eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
-  isResWord s = isInTree s $
-    B "lincat" (B "def" (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 "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
 
-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
+resWords = b "lincat" (b "def" (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 "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
+   where b s = B s (TS s)
 
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where
@@ -132,10 +130,10 @@ alexGetChar (p, _, (c:s)) =
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (p, c, s) = c
 
-alex_action_3 = tok (\p s -> PT p (TS s)) 
-alex_action_4 = tok (\p s -> PT p (eitherResIdent T_LString s)) 
-alex_action_5 = tok (\p s -> PT p (eitherResIdent TV s)) 
-alex_action_6 = tok (\p s -> PT p (TL $ unescapeInitTail s)) 
+alex_action_3 = tok (\p s -> PT p (TS $ shareString s)) 
+alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_LString . shareString) s)) 
+alex_action_5 = tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) 
+alex_action_6 = tok (\p s -> PT p (TL $ unescapeInitTail $ shareString s)) 
 alex_action_7 = tok (\p s -> PT p (TI s))    
 {-# LINE 1 "GenericTemplate.hs" #-}
 {-# LINE 1 "<built-in>" #-}