forked from GitHub/gf-core
Generated GF and GFC lexers with BNFC with string sharing support.
This commit is contained in:
@@ -1,8 +1,9 @@
|
||||
{-# OPTIONS -fglasgow-exts -cpp #-}
|
||||
{-# LINE 4 "LexGFC.x" #-}
|
||||
{-# LINE 3 "LexGFC.x" #-}
|
||||
module LexGFC where
|
||||
import SharedString -- H
|
||||
|
||||
import ErrM
|
||||
import SharedString
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 503
|
||||
import Data.Array
|
||||
@@ -34,13 +35,16 @@ alex_accept = listArray (0::Int,14) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_actio
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: String -> String
|
||||
share = shareString
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
@@ -69,15 +73,14 @@ 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
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
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)
|
||||
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
@@ -129,10 +132,10 @@ 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_2 = tok (\p s -> PT p (eitherResIdent (TV . shareString) s))
|
||||
alex_action_3 = tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s))
|
||||
alex_action_4 = tok (\p s -> PT p (TI s))
|
||||
alex_action_1 = tok (\p s -> PT p (TS $ share s))
|
||||
alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . share) s))
|
||||
alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s))
|
||||
alex_action_4 = tok (\p s -> PT p (TI $ share s))
|
||||
{-# LINE 1 "GenericTemplate.hs" #-}
|
||||
{-# LINE 1 "<built-in>" #-}
|
||||
{-# LINE 1 "<command line>" #-}
|
||||
|
||||
Reference in New Issue
Block a user