summaryrefslogtreecommitdiff
path: root/src/GF/Source/LexGF.x
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Source/LexGF.x')
-rw-r--r--src/GF/Source/LexGF.x52
1 files changed, 25 insertions, 27 deletions
diff --git a/src/GF/Source/LexGF.x b/src/GF/Source/LexGF.x
index 72431c578..0486b0f0e 100644
--- a/src/GF/Source/LexGF.x
+++ b/src/GF/Source/LexGF.x
@@ -4,7 +4,6 @@
module LexGF where
import ErrM
-import SharedString
}
@@ -23,30 +22,27 @@ $u = [\0-\255] -- universal: any character
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
$white+ ;
-@rsyms { tok (\p s -> PT p (TS $ share s)) }
-\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
+@rsyms { tok (\p s -> PT p (TS s)) }
+\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent T_LString s)) }
-$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
-\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
+$l $i* { tok (\p s -> PT p (eitherResIdent TV s)) }
+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail s)) }
-$d+ { tok (\p s -> PT p (TI $ share s)) }
+$d+ { tok (\p s -> PT p (TI s)) }
{
tok f p s = f p s
-share :: String -> String
-share = shareString
-
data Tok =
- TS !String -- reserved words
- | TL !String -- string literals
- | TI !String -- integer literals
- | TV !String -- identifiers
- | TD !String -- double precision float literals
- | TC !String -- character literals
- | T_LString !String
+ TS String -- reserved words
+ | TL String -- string literals
+ | TI String -- integer literals
+ | TV String -- identifiers
+ | TD String -- double precision float literals
+ | TC String -- character literals
+ | T_LString String
deriving (Eq,Show,Ord)
@@ -72,18 +68,20 @@ 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 = treeFind resWords
- where
- treeFind N = tv s
- treeFind (B a t left right) | s < a = treeFind left
- | s > a = treeFind right
- | s == a = t
-
-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)
+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))))
+
+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
unescapeInitTail :: String -> String
unescapeInitTail = unesc . tail where