msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Build cfgm files using the nondeterministic conversion. Allow coercions in cfgm rule functions and remove the name.

Browse Source
This commit is contained in:
bringert
2005-03-21 13:27:04 +00:00
parent 96a08c9df4
commit 75d228629a
9 changed files with 312 additions and 254 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
src/GF/CFGM/LexCFG.x
View File

@@ -4,6 +4,7 @@
module LexCFG where
import ErrM
}
@@ -15,32 +16,35 @@ $i = [$l $d _ '] -- identifier character
$u = [\0-\255] -- universal: any character
@rsyms = -- reserved words consisting of special symbols
\; | \: | \. | \- \> | \[ | \] | \,
\; | \: | \. | \- \> | \_ | \[ | \] | \,
:-
$white+ ;
@rsyms { tok (\p s -> PT p (TS s)) }
\' ($u # [\' \\]| \\ [\' \\]) * \' { tok (\p s -> PT p (eitherResIdent T_SingleQuoteString s)) }
@rsyms { tok (\p s -> PT p (TS $ share s)) }
\' ($u # [\' \\]| \\ [\' \\]) * \' { tok (\p s -> PT p (eitherResIdent (T_SingleQuoteString . share) s)) }
$l $i* { tok (\p s -> PT p (eitherResIdent TV s)) }
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail 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)) }
$d+ { tok (\p s -> PT p (TI s)) }
$d+ { tok (\p s -> PT p (TI $ share s)) }
{
tok f p s = f p s
share :: String -> String
share = id
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_SingleQuoteString 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_SingleQuoteString !String
deriving (Eq,Show,Ord)
@@ -62,24 +66,22 @@ prToken t = case t of
PT _ (TV s) -> s
PT _ (TD s) -> s
PT _ (TC s) -> s
_ -> show t
PT _ (T_SingleQuoteString s) -> s
_ -> 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 "grammar" (B "end" N N) (B "startcat" 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 "grammar" (b "end" N N) (b "startcat" N N)
where b s = B s (TS s)
unescapeInitTail :: String -> String
unescapeInitTail = unesc . tail where