GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
bringert
2004-12-06 19:08:58 +00:00
parent 0098d5e943
commit eaa2dcde07
4 changed files with 178 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/GF/Canon/LexGFC.hs
View File

@@ -65,20 +65,19 @@ 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 "lin" (B "concrete" (B "Type" (B "Str" (B "Ints" N N) N) (B "cat" (B "abstract" N N) N)) (B "fun" (B "flags" (B "data" N N) N) (B "in" (B "grammar" N N) N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" 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)
resWords = b "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" N N)))
where b s = B s (TS s)
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
@@ -130,7 +129,7 @@ alexGetChar (p, _, (c:s)) =
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (p, c, s) = c
alex_action_1 = tok (\p s -> PT p (TS (shareString s)))
alex_action_1 = tok (\p s -> PT p (TS $ shareString s))
alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . shareString) s))
alex_action_3 = tok (\p s -> PT p (TL $ unescapeInitTail $ shareString s))
alex_action_4 = tok (\p s -> PT p (TI s))

25
src/GF/Canon/LexGFC.x
View File

@@ -21,10 +21,10 @@ $u = [\0-\255] -- universal: any character
:-
$white+ ;
@rsyms { tok (\p s -> PT p (TS (shareString s))) } -- H
@rsyms { tok (\p s -> PT p (TS $ shareString s)) }
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) } -- H
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s)) } -- H
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail $ shareString s)) } -- H
$d+ { tok (\p s -> PT p (TI s)) }
@@ -64,20 +64,19 @@ 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 "lin" (B "concrete" (B "Type" (B "Str" (B "Ints" N N) N) (B "cat" (B "abstract" N N) N)) (B "fun" (B "flags" (B "data" N N) N) (B "in" (B "grammar" N N) N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" 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)
resWords = b "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" N N)))
where b s = B s (TS s)
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