Lexsyntax.x

   1 -- -*- haskell -*-
   2 -- This Alex file was machine-generated by the BNF converter
   3 {
   4 module Lexsyntax where
   5
   6 import ErrM
   7
   8 }
   9
  10
  11 $l = [a-zA-Z\192 - \255] # [\215 \247]    -- isolatin1 letter FIXME
  12 $c = [A-Z\192-\221] # [\215]    -- capital isolatin1 letter FIXME
  13 $s = [a-z\222-\255] # [\247]    -- small isolatin1 letter FIXME
  14 $d = [0-9]                -- digit
  15 $i = [$l $d _ ']          -- identifier character
  16 $u = [\0-\255]          -- universal: any character
  17
  18 @rsyms =    -- symbols and non-identifier-like reserved words
  19    \; | \{ | \} | \= | \( | \) | \+ \+ | \- \- | \- | \! | \, | \< | \< \= | \> | \> \= | \= \= | \! \= | \+ | \* | \/
  20
  21 :-
  22 "//" [.]* ; -- Toss single line comments
  23 "/*" ([$u # \*] | \* [$u # \/])* ("*")+ "/" ;
  24
  25 $white+ ;
  26 @rsyms { tok (\p s -> PT p (TS $ share s)) }
  27
  28 $l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
  29
  30
  31 $d+      { tok (\p s -> PT p (TI $ share s))    }
  32
  33
  34 {
  35
  36 tok f p s = f p s
  37
  38 share :: String -> String
  39 share = id
  40
  41 data Tok =
  42    TS !String     -- reserved words and symbols
  43  | TL !String     -- string literals
  44  | TI !String     -- integer literals
  45  | TV !String     -- identifiers
  46  | TD !String     -- double precision float literals
  47  | TC !String     -- character literals
  48
  49  deriving (Eq,Show,Ord)
  50
  51 data Token =
  52    PT  Posn Tok
  53  | Err Posn
  54   deriving (Eq,Show,Ord)
  55
  56 tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
  57 tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
  58 tokenPos _ = "end of file"
  59
  60 posLineCol (Pn _ l c) = (l,c)
  61 mkPosToken t@(PT p _) = (posLineCol p, prToken t)
  62
  63 prToken t = case t of
  64   PT _ (TS s) -> s
  65   PT _ (TI s) -> s
  66   PT _ (TV s) -> s
  67   PT _ (TD s) -> s
  68   PT _ (TC s) -> s
  69
  70   _ -> show t
  71
  72 data BTree = N | B String Tok BTree BTree deriving (Show)
  73
  74 eitherResIdent :: (String -> Tok) -> String -> Tok
  75 eitherResIdent tv s = treeFind resWords
  76   where
  77   treeFind N = tv s
  78   treeFind (B a t left right) | s < a  = treeFind left
  79                               | s > a  = treeFind right
  80                               | s == a = t
  81
  82 resWords = b "print" (b "false" (b "else" (b "bool" N N) N) (b "int" (b "if" N N) N)) (b "return" (b "readInt" (b "readBool" N N) N) (b "while" (b "true" N N) N))
  83    where b s = B s (TS s)
  84
  85 unescapeInitTail :: String -> String
  86 unescapeInitTail = unesc . tail where
  87   unesc s = case s of
  88     '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
  89     '\\':'n':cs  -> '\n' : unesc cs
  90     '\\':'t':cs  -> '\t' : unesc cs
  91     '"':[]    -> []
  92     c:cs      -> c : unesc cs
  93     _         -> []
  94
  95 -------------------------------------------------------------------
  96 -- Alex wrapper code.
  97 -- A modified "posn" wrapper.
  98 -------------------------------------------------------------------
  99
 100 data Posn = Pn !Int !Int !Int
 101       deriving (Eq, Show,Ord)
 102
 103 alexStartPos :: Posn
 104 alexStartPos = Pn 0 1 1
 105
 106 alexMove :: Posn -> Char -> Posn
 107 alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
 108 alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
 109 alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
 110
 111 type AlexInput = (Posn, -- current position,
 112                   Char, -- previous char
 113                   String)       -- current input string
 114
 115 tokens :: String -> [Token]
 116 tokens str = go (alexStartPos, '\n', str)
 117     where
 118       go :: (Posn, Char, String) -> [Token]
 119       go inp@(pos, _, str) =
 120           case alexScan inp 0 of
 121             AlexEOF                -> []
 122             AlexError (pos, _, _)  -> fail $ show pos ++ ": lexical error"
 123             AlexSkip  inp' len     -> go inp'
 124             AlexToken inp' len act -> act pos (take len str) : (go inp')
 125
 126 alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
 127 alexGetChar (p, c, [])    = Nothing
 128 alexGetChar (p, _, (c:s)) =
 129     let p' = alexMove p c
 130      in p' `seq` Just (c, (p', c, s))
 131
 132 alexInputPrevChar :: AlexInput -> Char
 133 alexInputPrevChar (p, c, s) = c
 134 }