diff options
| author | bringert <bringert@cs.chalmers.se> | 2006-11-30 22:50:25 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2006-11-30 22:50:25 +0000 |
| commit | ba13ff08d2dd38de9abdb8b59125b73471404d44 (patch) | |
| tree | 0df109b56f1827042f6b6d7ad71cc1dd22decf99 /src/GF/JavaScript/LexJS.x | |
| parent | c2ecc9d5543a7fc495edbe03ec8cb2e9632dc774 (diff) | |
Added the beginnings of GFCC to JavaScript conversion.
Diffstat (limited to 'src/GF/JavaScript/LexJS.x')
| -rw-r--r-- | src/GF/JavaScript/LexJS.x | 132 |
1 files changed, 132 insertions, 0 deletions
diff --git a/src/GF/JavaScript/LexJS.x b/src/GF/JavaScript/LexJS.x new file mode 100644 index 000000000..382092d6a --- /dev/null +++ b/src/GF/JavaScript/LexJS.x @@ -0,0 +1,132 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module GF.JavaScript.LexJS where + + +} + + +$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 = -- symbols and non-identifier-like reserved words + \( | \) | \{ | \} | \, | \; | \. | \[ | \] + +:- + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share 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 $ share s)) } +$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } + +{ + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | 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) + +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 + + _ -> 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 "null" (b "function" (b "false" N N) (b "new" N N)) (b "this" (b "return" N N) (b "true" 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, _, _) -> [Err pos] + 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 +} |
