forked from GitHub/gf-core
More sharing of reserved words in GF and GFC lexers. Added GF lexer alex file.
This commit is contained in:
bringert
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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>" #-}
|
||||
|
||||
134
src/GF/Source/LexGF.x
Normal file
134
src/GF/Source/LexGF.x
Normal file
@@ -0,0 +1,134 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
-- Lines with -- H have been hacked for greater performance
|
||||
{
|
||||
module LexGF where
|
||||
import SharedString -- H
|
||||
import ErrM
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- reserved words consisting of special symbols
|
||||
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \. | \| | \? | \< | \> | \@ | \! | \* | \\ | \= \> | \+ \+ | \+ | \_ | \$ | \/ | \-
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS $ shareString s)) } -- H
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . shareString) s)) } -- H
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) } -- H
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail $ shareString s)) } -- H
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI s)) }
|
||||
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
data Tok =
|
||||
TS !String -- reserved words -- H
|
||||
| TL !String -- string literals -- H
|
||||
| TI String -- integer literals
|
||||
| TV !String -- identifiers -- H
|
||||
| TD String -- double precision float literals
|
||||
| TC String -- character literals
|
||||
| T_LString !String -- H
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
PT _ (T_LString s) -> s
|
||||
|
||||
_ -> 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)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
String) -- current input string
|
||||
|
||||
tokens :: String -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: (Posn, Char, String) -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error"
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, c, []) = Nothing
|
||||
alexGetChar (p, _, (c:s)) =
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
Reference in New Issue
Block a user