Commit e31ac97a authored by Taddeüs Kroes's avatar Taddeüs Kroes

Fixes in token case-sensitivity, hex color parsing and stringification

parent 7c7dcabd
......@@ -35,6 +35,8 @@ parser.mli: parser.ml
parse.cmx: lexer.cmi parser.cmx
util.cmx: stringify.cmx
main.cmx: parse.cmx util.cmx
stringify.cmx parser.cmi parser.cmx lexer.cmx util.cmx parse.cmx main.cmx: \
types.cmi
clean:
rm -f *.cmi *.cmx *.o lexer.ml parser.ml parser.mli parser.conflicts \
......
......@@ -15,30 +15,30 @@
let strip_quotes s = String.sub s 1 (String.length s - 2)
}
let h = ['0'-'9''a'-'f']
let wc = '\r''\n' | [' ''\t''\r''\n''\012']
let h = ['0'-'9' 'a'-'f' 'A'-'F']
let wc = '\r' '\n' | [' ' '\t' '\r' '\n' '\012']
let nonascii = ['\160'-'\255']
let s = [' ''\t''\r''\n''\012']+
let s = [' ' '\t' '\r' '\n' '\012']+
let w = s?
let nl = '\n' | '\r''\n' | '\r' | '\012'
let nl = '\n' | '\r' '\n' | '\r' | '\012'
let unicode = '\\' h(h(h(h(h(h)?)?)?)?)? wc?
let escape = unicode | '\\'[^'\r''\n''\012''0'-'9''a'-'f']
let nmstart = ['_''a'-'z'] | nonascii | escape
let nmchar = ['_''a'-'z''0'-'9''-'] | nonascii | escape
let string1 = '"'([^'\n''\r''\012''"'] | '\\'nl | escape)*'"'
let string2 = '\''([^'\n''\r''\012''\''] | '\\'nl | escape)*'\''
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
let string1 = '"'([^'\n' '\r' '\012' '"'] | '\\'nl | escape)*'"'
let string2 = '\'' ([^'\n' '\r' '\012' '\''] | '\\' nl | escape)* '\''
let mystring = string1 | string2
let badstring1 = '"'([^'\n''\r''\012''"'] | '\\'nl | escape)*'\\'?
let badstring2 = '\''([^'\n''\r''\012''\''] | '\\'nl | escape)*'\\'?
let badstring1 = '"' ([^'\n' '\r' '\012' '"'] | '\\'nl | escape)* '\\'?
let badstring2 = '\'' ([^'\n' '\r' '\012' '\''] | '\\'nl | escape)* '\\'?
let badstring = badstring1 | badstring2
let badcomment1 = '/''*'[^'*']*'*'+([^'/''*'][^'*']*'*'+)*
let badcomment2 = '/''*'[^'*']*('*'+[^'/''*'][^'*']*)*
let badcomment1 = '/' '*'[^'*']*'*'+([^'/' '*'][^'*']*'*'+)*
let badcomment2 = '/' '*'[^'*']*('*'+[^'/' '*'][^'*']*)*
let badcomment = badcomment1 | badcomment2
let baduri1 = "url("w(['!''#''$''%''&''*'-'['']'-'~'] | nonascii | escape)*w
let baduri2 = "url("w mystring w
let baduri3 = "url("w badstring
let baduri1 = "url(" w (['!' '#' '$' '%' '&' '*'-'[' ']'-'~'] | nonascii | escape)* w
let baduri2 = "url(" w mystring w
let baduri3 = "url(" w badstring
let baduri = baduri1 | baduri2 | baduri3
let comment = '/''*'[^'*']*'*'+([^'/''*'][^'*']*'*'+)'*''/'
let comment = "/*" [^'*']* '*'+ ([^'/' '*'] [^'*']* '*'+) "*/"
let ident = '-'? nmstart nmchar*
let name = nmchar+
let num = ['0'-'9']+ | ['0'-'9']*'.'['0'-'9']+
......
......@@ -26,7 +26,7 @@
let rec transform_ops = function
| [] -> []
| Term left :: Operator op :: Term right :: tl ->
Nary (op, [left; right]) :: transform_ops tl
transform_ops (Term (Nary (op, [left; right])) :: tl)
| Term hd :: tl -> hd :: transform_ops tl
| Operator op :: _ -> raise (SyntaxError ("unexpected operator \"" ^ op ^ "\""))
in
......@@ -36,13 +36,7 @@
Nary (op, flatten_nary left @ flatten_nary right) :: flatten_nary tl
| hd :: tl -> hd :: flatten_nary tl
in
let comma_to_concat =
List.map (transform_value (function
| Nary (",", terms) -> Concat terms
| value -> value
))
in
match terms |> transform_ops |> flatten_nary |> comma_to_concat with
match terms |> transform_ops |> flatten_nary with
| [hd] -> hd
| l -> Concat l
%}
......@@ -79,15 +73,15 @@ stylesheet:
{ s }
charset:
| CHARSET_SYM name=STRING SEMICOL
| CHARSET_SYM S? name=STRING S? SEMICOL
{ Charset name }
%inline string_or_uri:
| s=STRING | s=URI
{ s }
import:
| IMPORT_SYM S? tgt=string_or_uri media=wslist(COMMA, IDENT) SEMICOL S?
{ Import (tgt, media) }
%inline string_or_uri:
| str=STRING { Strlit str }
| uri=URI { Uri uri }
media:
| MEDIA_SYM queries=wslist(COMMA, IDENT) LBRACE S? rulesets=ruleset* RBRACE S?
......@@ -112,12 +106,12 @@ ruleset:
{ Ruleset (selectors_hd :: selectors_tl, decls) }
selector:
| hd=simple_selector S?
{ [hd] }
| hd=simple_selector S tl=selector
{ hd :: tl }
| hd=simple_selector S? c=combinator tl=selector
{ hd :: c :: tl }
| simple=simple_selector S?
{ Simple simple }
| left=simple_selector S right=selector
{ Combinator (Simple left, " ", right) }
| left=simple_selector S? com=combinator right=selector
{ Combinator (Simple left, com, right) }
%inline combinator:
| PLUS S? { "+" }
| c=COMBINATOR S? { c }
......@@ -145,7 +139,7 @@ attrib:
"[" ^ left ^ right ^ "]" }
%inline rel_value:
| S? id=IDENT S? { id }
| S? s=STRING S? { s }
| S? s=STRING S? { "\"" ^ s ^ "\"" }
pseudo:
| COLON id=IDENT
......@@ -156,7 +150,7 @@ pseudo:
declaration:
| name=IDENT S? COLON S? value=expr important=boption(pair(IMPORTANT_SYM, S?))
{ (name, value, important) }
{ (String.lowercase name, value, important) }
expr:
| l=exprl { concat_terms l }
......@@ -187,9 +181,11 @@ term:
| fn=FUNCTION arg=expr RPAREN S?
{ Function (fn, arg) }
| hex=HASH S?
{ if Str.string_match (Str.regexp "\\d{3}\\d{3}?") hex 0
then Hexcolor hex
{ let h = "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]" in
if Str.string_match (Str.regexp ("^" ^ h ^ "\\(" ^ h ^ "\\)?$")) hex 0
then Hexcolor (String.lowercase hex)
else raise (SyntaxError ("invalid color #" ^ hex)) }
%inline unary_operator:
unary_operator:
| MINUS { "-" }
| PLUS { "+" }
......@@ -14,6 +14,10 @@ let string_of_num n =
then string_of_int (int_of_float n)
else string_of_float n
(*
* Pretty-printing
*)
let rec string_of_expr = function
| Ident id -> id
| Strlit str -> "\"" ^ str ^ "\""
......@@ -25,25 +29,33 @@ let rec string_of_expr = function
| Function (name, arg) -> name ^ "(" ^ string_of_expr arg ^ ")"
| Hexcolor hex -> "#" ^ hex
| Unary (op, opnd) -> op ^ string_of_expr opnd
| Nary (",", opnds) -> cat ", " string_of_expr opnds
| Nary (op, opnds) -> cat op string_of_expr opnds
let string_of_declaration (name, value, important) =
let imp = if important then " !important" else "" in
name ^ ": " ^ string_of_expr value ^ imp ^ ";"
let rec string_of_selector = function
| Simple simple -> simple
| Combinator (left, " ", right) ->
string_of_selector left ^ " " ^ string_of_selector right
| Combinator (left, com, right) ->
string_of_selector left ^ " " ^ com ^ " " ^ string_of_selector right
let block body = " {\n" ^ indent body ^ "\n}"
let rec string_of_statement = function
| Ruleset (selectors, decls) ->
cat ", " (String.concat " ") selectors ^
cat ", " string_of_selector selectors ^
block (cat "\n" string_of_declaration decls)
| Media (queries, rulesets) ->
"@media " ^ String.concat ", " queries ^
block (cat "\n\n" string_of_statement rulesets)
| Import (filename, []) ->
"@import \"" ^ filename ^ "\";"
| Import (filename, queries) ->
"@import \"" ^ filename ^ "\" " ^ String.concat ", " queries ^ ";"
| Import (target, []) ->
"@import " ^ string_of_expr target ^ ";"
| Import (target, queries) ->
"@import " ^ string_of_expr target ^ " " ^ String.concat ", " queries ^ ";"
| Charset charset ->
"@charset \"" ^ charset ^ "\";"
| Page (None, decls) ->
......@@ -58,3 +70,45 @@ let rec string_of_statement = function
"@namespace " ^ prefix ^ " \"" ^ uri ^ "\";"
let string_of_stylesheet = cat "\n\n" string_of_statement
(*
* Minified stringification
*)
let rec minify_expr = function
| Concat values -> cat " " minify_expr values
| Function (name, arg) -> name ^ "(" ^ minify_expr arg ^ ")"
| Unary (op, opnd) -> op ^ minify_expr opnd
| Nary (",", opnds) -> cat "," minify_expr opnds
| Nary (op, opnds) -> cat op minify_expr opnds
| expr -> string_of_expr expr
let minify_declaration (name, value, important) =
let imp = if important then "!important" else "" in
name ^ ":" ^ minify_expr value ^ imp
let rec minify_selector = function
| Simple simple -> simple
| Combinator (left, com, right) ->
minify_selector left ^ com ^ minify_selector right
let rec minify_statement = function
| Ruleset (selectors, decls) ->
cat "," minify_selector selectors ^
"{" ^ (cat ";" minify_declaration decls) ^ "}"
| Media (queries, rulesets) ->
"@media " ^ String.concat "," queries ^
"{" ^ (cat "" minify_statement rulesets) ^ "}"
| Import (target, []) ->
"@import " ^ string_of_expr target ^ ";"
| Import (target, queries) ->
"@import " ^ string_of_expr target ^ " " ^ String.concat "," queries ^ ";"
| Page (None, decls) ->
"@page{" ^ cat "" minify_declaration decls ^ "}"
| Page (Some pseudo, decls) ->
"@page :" ^ pseudo ^ "{" ^ cat "" minify_declaration decls ^ "}"
| Fontface decls ->
"@font-face{" ^ cat "" minify_declaration decls ^ "}"
| statement -> string_of_statement statement
let minify_stylesheet = cat "" minify_statement
......@@ -11,15 +11,17 @@ type expr =
type declaration = string * expr * bool
type selector = string list
type selector =
| Simple of string
| Combinator of selector * string * selector
type statement =
| Ruleset of selector list * declaration list
(* <selectors> { <declarations> } *)
| Media of string list * statement list
(* @media <queries> { <rulesets> } *)
| Import of string * string list
(* @import "<file>" [<media>]; *)
| Import of expr * string list
(* @import <target> [<media>]; *)
| Charset of string
(* @charset "<charset>"; *)
| Page of string option * declaration list
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment