lexer.mll 6.67 KB
Newer Older
1
{
Taddeüs Kroes's avatar
Taddeüs Kroes committed
2 3 4 5
  (* Tokenizer according to definition at
   * http://www.w3.org/TR/CSS2/syndata.html#tokenization *)
  open Lexing
  open Parser
6
  open Types
7

8 9 10 11 12 13 14 15 16 17 18
  let advance_pos lexbuf =
    let s = Lexing.lexeme lexbuf in
    let rec search from lines =
      try
        ignore (Str.search_forward (Str.regexp "\r\n\\|\r\\|\n") s from);
        search (Str.match_end ()) (lines + 1)
      with Not_found ->
        lines, String.length s - from
    in
    let lines, cols = search 0 0 in

Taddeüs Kroes's avatar
Taddeüs Kroes committed
19 20
    let pos = lexbuf.lex_curr_p in
    lexbuf.lex_curr_p <- {
21 22
      pos with pos_bol = lexbuf.lex_curr_pos - cols;
               pos_lnum = pos.pos_lnum + lines
Taddeüs Kroes's avatar
Taddeüs Kroes committed
23
    }
24 25

  let strip_quotes s = String.sub s 1 (String.length s - 2)
26 27
}

28 29
let h           = ['0'-'9' 'a'-'f' 'A'-'F']
let wc          = '\r' '\n' | [' ' '\t' '\r' '\n' '\012']
Taddeüs Kroes's avatar
Taddeüs Kroes committed
30
let nonascii    = ['\160'-'\255']
31
let s           = [' ' '\t' '\r' '\n' '\012']+
Taddeüs Kroes's avatar
Taddeüs Kroes committed
32
let w           = s?
33
let nl          = '\n' | '\r' '\n' | '\r' | '\012'
Taddeüs Kroes's avatar
Taddeüs Kroes committed
34
let unicode     = '\\' h(h(h(h(h(h)?)?)?)?)? wc?
35 36 37
let escape      = unicode | '\\'[^'\r' '\n' '\012' '0'-'9' 'a'-'f' 'A'-'F']
let nmstart     = ['_' 'a'-'z' 'A'-'Z'] | nonascii | escape
let nmchar      = ['_' 'a'-'z' 'A'-'Z' '0'-'9' '-'] | nonascii | escape
38
let string1     = '"' ([^'\n' '\r' '\012' '"'] | '\\'nl | escape)* '"'
39
let string2     = '\'' ([^'\n' '\r' '\012' '\''] | '\\' nl | escape)* '\''
Taddeüs Kroes's avatar
Taddeüs Kroes committed
40
let mystring    = string1 | string2
41 42
let badstring1  = '"' ([^'\n' '\r' '\012' '"'] | '\\'nl | escape)* '\\'?
let badstring2  = '\'' ([^'\n' '\r' '\012' '\''] | '\\'nl | escape)* '\\'?
Taddeüs Kroes's avatar
Taddeüs Kroes committed
43
let badstring   = badstring1 | badstring2
Taddeüs Kroes's avatar
Taddeüs Kroes committed
44 45
let badcomment1 = "/*" [^'*']* '*'+ ([^'/' '*'] [^'*']* '*'+)*
let badcomment2 = "/*" [^'*']* ('*'+ [^'/' '*'] [^'*']*)*
Taddeüs Kroes's avatar
Taddeüs Kroes committed
46
let badcomment  = badcomment1 | badcomment2
47 48 49
let baduri1     = "url(" w (['!' '#' '$' '%' '&' '*'-'[' ']'-'~'] | nonascii | escape)* w
let baduri2     = "url(" w mystring w
let baduri3     = "url(" w badstring
Taddeüs Kroes's avatar
Taddeüs Kroes committed
50
let baduri      = baduri1 | baduri2 | baduri3
Taddeüs Kroes's avatar
Taddeüs Kroes committed
51
let comment     = "/*" [^'*']* '*'+ ([^'/' '*'] [^'*']* '*'+)* '/'
Taddeüs Kroes's avatar
Taddeüs Kroes committed
52 53
let ident       = '-'? nmstart nmchar*
let name        = nmchar+
Taddeüs Kroes's avatar
Taddeüs Kroes committed
54
let num         = ['0'-'9']+ | ['0'-'9']* '.' ['0'-'9']+
55
let url         = (['!' '#' '$' '%' '&' '*'-'~'] | nonascii | escape)*
Taddeüs Kroes's avatar
Taddeüs Kroes committed
56

57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
let A = ['a' 'A']
let B = ['b' 'B']
let C = ['c' 'C']
let D = ['d' 'D']
let E = ['e' 'E']
let F = ['f' 'F']
let G = ['g' 'G']
let H = ['h' 'H']
let I = ['i' 'I']
let J = ['j' 'J']
let K = ['k' 'K']
let L = ['l' 'L']
let M = ['m' 'M']
let N = ['n' 'N']
let O = ['o' 'O']
let P = ['p' 'P']
let Q = ['q' 'Q']
let R = ['r' 'R']
let S = ['s' 'S']
let T = ['t' 'T']
let U = ['u' 'U']
let V = ['v' 'V']
let W = ['w' 'W']
let X = ['x' 'X']
let Y = ['y' 'Y']
let Z = ['z' 'Z']


85
rule token = parse
86 87 88
  | "\r\n" | '\r' | '\n'  { new_line lexbuf; S }
  | [' ' '\t' '\012']+  { S }
  | "/*"                { comment lexbuf }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
89 90 91

  | "<!--"              { CDO }
  | "-->"               { CDC }
92 93
  | ['~' '^' '$' '*' '|']? '=' as op  { RELATION op }
  | ['>' '~'] as c      { COMBINATOR (Char.escaped c) }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
94

95
  | mystring as s       { STRING (strip_quotes s) }
96
  | badstring           { raise (Syntax_error "bad string") }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
97

98
  | '#' (name as nm)    { HASH nm }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
99

100 101 102 103 104 105 106
  | '@' I M P O R T               { IMPORT_SYM }
  | '@' P A G E                   { PAGE_SYM }
  | '@' M E D I A                 { MEDIA_SYM }
  | "@charset "                   { CHARSET_SYM }
  | '@' F O N T '-' F A C E       { FONT_FACE_SYM }
  | '@' N A M E S P A C E         { NAMESPACE_SYM }
  | '@' S U P P O R T S           { SUPPORTS_SYM }
107 108
  | '@' (('-' ident '-')? as prefix) K E Y F R A M E S
  { KEYFRAMES_SYM (String.lowercase prefix) }
109 110
  | '@' (('-' ident '-')? as prefix) V I E W P O R T
  { VIEWPORT_SYM (String.lowercase prefix) }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
111

112 113 114 115
  | (s | comment)* s comment* A N D comment* s (s | comment)*
  { advance_pos lexbuf; WS_AND }
  | (s | comment)* s comment* O R   comment* s (s | comment)*
  { advance_pos lexbuf; WS_OR }
116

117 118 119 120 121 122
  | (['-' '+'] as a_sign)? (['0'-'9']* as a) N
    (w (['-' '+'] as b_sign) w (['0'-'9']+ as b))?
  {
    let a = if a = "" then 1 else int_of_string a in
    let b = match b with None -> 0 | Some n -> int_of_string n in
    let apply_sign n = function Some '-' -> -n | _ -> n in
Taddeüs Kroes's avatar
Taddeüs Kroes committed
123
    FORMULA (apply_sign a a_sign, apply_sign b b_sign)
124 125
  }

126 127 128
  | O N L Y             { ONLY }
  | N O T               { NOT }
  | A N D               { AND }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
129
  (*| O R                 { OR } removed in favor of WS_OR *)
130 131
  | F R O M             { FROM }
  | T O                 { TO }
132 133
  | O D D               { ODD }
  | E V E N             { EVEN }
134 135 136

  | ident as id         { IDENT id }

137
  | '!' (s | comment)* I M P O R T A N T  { IMPORTANT_SYM }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
138

139 140 141
  |  (num as n) '%'     { PERCENTAGE (float_of_string n) }
  |  (num as n) (E M | E X | P X | C M | M M | I N | P T | P C | D E G |
                 G? R A D | M? S | K? H Z | D P (I | C M) | ident as u)
142 143
  { UNIT_VALUE (float_of_string n, u) }
  | num as n            { NUMBER (float_of_string n) }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
144

145 146 147 148 149 150
  | "url(" w (mystring as uri) w ")"  { advance_pos lexbuf; URI (strip_quotes uri) }
  | "url(" w (url as uri) w ")"       { advance_pos lexbuf; URI uri }
  | baduri              { raise (Syntax_error "bad uri") }
  (*
  | "url("              { url_start lexbuf }
  *)
Taddeüs Kroes's avatar
Taddeüs Kroes committed
151 152 153

  | (ident as fn) '('   { FUNCTION fn }

154
  | '('                 { LPAREN }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
155 156 157 158 159 160 161
  | ')'                 { RPAREN }
  | '{'                 { LBRACE }
  | '}'                 { RBRACE }
  | '['                 { LBRACK }
  | ']'                 { RBRACK }
  | ';'                 { SEMICOL }
  | ':'                 { COLON }
162
  | "::"                { DOUBLE_COLON }
163 164 165 166 167 168 169
  | ','                 { COMMA }

  | '.'                 { DOT }
  | '+'                 { PLUS }
  | '-'                 { MINUS }
  | '/'                 { SLASH }
  | '*'                 { STAR }
Taddeüs Kroes's avatar
Taddeüs Kroes committed
170

171 172
  | eof | '\000'        { EOF }

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
  | _ as c { raise (Syntax_error ("unexpected '" ^ Char.escaped c ^ "'")) }

(* Comments *)
and comment = parse
  | '\r' | '\n' | "\r\n"  { new_line lexbuf; comment lexbuf }
  | "*/"                  { token lexbuf }
  | eof | '\000'          { raise (Syntax_error "unclosed comment") }
  | _                     { comment lexbuf }

(*
(* URLs *)
and url_start = parse
  | '\r' | '\n' | "\r\n"  { new_line lexbuf; url_start lexbuf }
  | [' ' '\t' '\012']+    { url_start lexbuf }
  | urlc+ as uri          { url_end uri lexbuf }
  | ')'                   { URI "" }
  | mystring as s         { url_end (strip_quotes s) lexbuf }
  | badstring             { raise (Syntax_error "bad string") }
  | (eof | '\000' | _) as c { raise (Syntax_error ("unexpected '" ^ c ^ "'")) }
and url_end uri = parse
  | '\r' | '\n' | "\r\n"  { new_line lexbuf; url_end uri lexbuf }
  | [' ' '\t' '\012']+    { url_end uri lexbuf }
  | ')'                   { URI uri }
  | (eof | '\000' | _) as c { raise (Syntax_error ("unexpected '" ^ c ^ "'")) }
*)