Skip to content

M
mincss
Commit 5c088307 authored by Taddeüs Kroes's avatar Taddeüs Kroes
Browse files
Options

First version of parser that compiles (still conflicts to resolve)

parent bbb79f6f
Hide whitespace changes
Inline Side-by-side
Showing with 213 additions and 107 deletions
lexer.mll
View file @ 5c088307
......@@ -3,8 +3,7 @@
* http://www.w3.org/TR/CSS2/syndata.html#tokenization *)
open Lexing
open Parser
exception SyntaxError of string
open Types
let next_line lexbuf =
let pos = lexbuf.lex_curr_p in
......@@ -51,15 +50,15 @@ rule token = parse
| "<!--" { CDO }
| "-->" { CDC }
| "~=" { INCLUDES }
| "|=" { DASHMATCH }
| ['~''|']?'=' as op { RELATION op }
| ['>''~'] as c { COMBINATOR (Char.escaped c) }
| mystring { STRING }
| badstring { BAD_STRING }
| mystring as s { STRING s }
| badstring as s { raise (SyntaxError "bad string") }
| ident as id { IDENT id }
| '#' (name as name) { HASH name }
| '#' (name as nm) { HASH nm }
| "@import" { IMPORT_SYM }
| "@page" { PAGE_SYM }
......@@ -68,32 +67,17 @@ rule token = parse
| '!' (w | comment)* "important" { IMPORTANT_SYM }
| (num as n) "em" { EMS (int_of_string n) }
| (num as n) "ex" { EXS (int_of_string n) }
| (num as n) "px" { LENGTH (int_of_string n, "px") }
| (num as n) "cm" { LENGTH (int_of_string n, "cm") }
| (num as n) "mm" { LENGTH (int_of_string n, "mm") }
| (num as n) "in" { LENGTH (int_of_string n, "in") }
| (num as n) "pt" { LENGTH (int_of_string n, "pt") }
| (num as n) "pc" { LENGTH (int_of_string n, "pc") }
| (num as n) "deg" { ANGLE (int_of_string n, "deg") }
| (num as n) "rad" { ANGLE (int_of_string n, "rad") }
| (num as n) "grad" { ANGLE (int_of_string n, "grad") }
| (num as n) "ms" { TIME (int_of_string n, "ms") }
| (num as n) "s" { TIME (int_of_string n, "s") }
| (num as n) "hz" { FREQ (int_of_string n, "hz") }
| (num as n) "khz" { FREQ (int_of_string n, "khz") }
| (num as n) "%" { PERCENTAGE (int_of_string n) }
| (num as n) (ident as dim) { DIMENSION (int_of_string n, dim) }
| num as n { NUMBER (int_of_string n) }
| (num as n) ("em"|"ex"|"px"|"cm"|"mm"|"in"|"pt"|"pc"|"deg"|"rad"|"grad"|
"ms"|"s"|"hz"|"khz"|"%"|ident as u)
{ UNIT_VALUE (float_of_string n, u) }
| num as n { NUMBER (float_of_string n) }
| "url(" w (mystring as uri) w ")" { URI uri }
| "url(" w (url as uri) w ")" { URI uri }
| baduri as uri { BAD_URI uri }
| baduri as uri { raise (SyntaxError "bad uri") }
| (ident as fn) '(' { FUNCTION fn }
| '(' { LPAREN }
| ')' { RPAREN }
| '{' { LBRACE }
| '}' { RBRACE }
......@@ -101,6 +85,13 @@ rule token = parse
| ']' { RBRACK }
| ';' { SEMICOL }
| ':' { COLON }
| ',' { COMMA }
| '.' { DOT }
| '+' { PLUS }
| '-' { MINUS }
| '/' { SLASH }
| '*' { STAR }
(*
| _ as c { raise (SyntaxError ("illegal string character: " ^ Char.escaped c)) }
......
parse.ml
View file @ 5c088307
......@@ -27,7 +27,7 @@ let parse_input display_name content =
let lexbuf = Lexing.from_string content in
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
try Parser.stylesheet Lexer.token lexbuf with
| Lexer.SyntaxError msg ->
| SyntaxError msg ->
raise (LocError (shift_back lexbuf, msg))
| Parser.Error ->
raise (LocError (shift_back lexbuf, "syntax error"))
parser.mly
View file @ 5c088307
......@@ -2,61 +2,148 @@
open Lexing
open Types
let prop2str (name, value) = name ^ ":" ^ Stringify.value2str value
let filter_none l =
let rec filter l = function
| [] -> []
| None :: tl -> filter l tl
| Some hd :: tl -> filter (hd :: l) tl
in
List.rev (filter [] l)
%}
(* Tokens *)
%token S CDO CDC INCLUDES DASHMATCH STRING BAD_STRING IMPORT_SYM PAGE_SYM
%token MEDIA_SYM CHARSET_SYM IMPORTANT_SYM
%token LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON
%token <int> EMS EXS PERCENTAGE NUMBER
%token <int * string> LENGTH ANGLE TIME FREQ DIMENSION
%token <string> IDENT HASH URI BAD_URI FUNCTION
%token S CDO CDC IMPORT_SYM PAGE_SYM MEDIA_SYM CHARSET_SYM
%token IMPORTANT_SYM
%token <float> NUMBER
%token <float * string> UNIT_VALUE
%token <string> COMBINATOR RELATION STRING IDENT HASH URI FUNCTION
%token RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON COMMA DOT PLUS MINUS
%token SLASH STAR
(* Start symbol *)
%type <Types.decl list> stylesheet
%type <Types.stylesheet> stylesheet
%start stylesheet
%%
(* Left-recursive list (use List.rev to obtain correctly ordered list) *)
(*
llist(x):
| { [] }
| tl=llist(x) hd=x { hd :: tl }
*)
%inline mylist(sep, x):
| l=separated_list(sep, delimited(S*, x, S*))
{ l }
cd: CDO S* | CDC S* {}
%inline statement: r=ruleset | r=media | r=page { r }
stylesheet:
| ( CDO | CDC | S | statement )*
| charset = charset? S* cd*
imports = terminated(import, cd*)*
statements = terminated(statement, cd*)*
{ let charset = match charset with None -> [] | Some c -> [c] in
charset @ imports @ statements }
charset:
| CHARSET_SYM set=STRING SEMICOL
{ Charset set }
%inline string_or_uri: s=STRING | s=URI { s }
import:
| IMPORT_SYM S* tgt=string_or_uri media=mylist(COMMA, IDENT) SEMICOL S*
{ Import (tgt, media) }
statement:
| ruleset
| at_rule
media:
| MEDIA_SYM S* queries=mylist(COMMA, IDENT) LBRACE S* rulesets=ruleset* RBRACE S*
{ Media (queries, rulesets) }
at_rule:
| ATKEYWORD S* any* ( block | SEMICOL S* )
page:
| PAGE_SYM S* pseudo=pseudo_page? decls=decls_block
{ Page (pseudo, decls) }
block:
| LBRACE S* ( any | block | ATKEYWORD S* | SEMICOL S* )* RBRACE S*
pseudo_page:
| COLON pseudo=IDENT S*
{ pseudo }
decls_block:
| LBRACE S* decls=mylist(SEMICOL, declaration?) RBRACE S*
{ filter_none decls }
ruleset:
| selectors=any+ LBRACE S* declaration? ( SEMICOL S* declaration? )* RBRACE S*
| selectors_hd = selector
selectors_tl = separated_list(COMMA, preceded(S*, selector))
decls = decls_block
{ Ruleset (selectors_hd :: selectors_tl, decls) }
%inline combinator:
| S* PLUS S* { ["+"] }
| S* c=COMBINATOR S* { [c] }
| S+ { [] }
selector:
| hd=simple_selector comb=combinator tl=selector
{ hd :: comb @ tl }
| simple=simple_selector
{ [simple] }
simple_selector:
| elem=element_name addons=element_addon*
{ elem ^ String.concat "" addons }
| addons=element_addon+
{ String.concat "" addons }
element_addon:
| a=HASH | a=cls | a=attrib | a=pseudo
{ a }
cls:
| DOT name=IDENT
{ "." ^ name }
element_name:
| tag=IDENT { tag }
| STAR { "*" }
%inline rel_value:
| S* id=IDENT S* { id }
| S* s=STRING S* { s }
attrib:
| LBRACK S* left=IDENT S* right=pair(RELATION, rel_value)? RBRACK
{ left ^ (match right with None -> "" | Some (rel, term) -> rel ^ term) }
pseudo:
| COLON id=IDENT
{ ":" ^ id }
| COLON f=FUNCTION S* arg=terminated(IDENT, S*)? RPAREN
{ let arg = match arg with None -> "" | Some id -> id in
":" ^ f ^ "(" ^ arg ^ ")" }
declaration:
| name=IDENT S* COLON S* value=value
{ Property (name, value) }
value:
| ( any | block | ATKEYWORD S* )+
any:
| ( IDENT | NUMBER | PERCENTAGE | DIMENSION | STRING | DELIM | URI | HASH |
UNICODE-RANGE | INCLUDES | DASHMATCH | COLON | FUNCTION S* (any|unused)*
RPAREN | LPAREN S* (any|unused)* RPAREN | LBRACK S* (any|unused)* RBRACK) S*
unused:
| block
| ATKEYWORD S*
| SEMICOL S*
| CDO S*
| CDC S*
| name=IDENT S* COLON S* value=expr IMPORTANT_SYM S*
{ (name, Prio value) }
| name=IDENT S* COLON S* value=expr
{ (name, value) }
%inline unary_operator:
| MINUS { "-" }
| PLUS { "+" }
expr:
| left=expr right=expr
{ Concat [left; right] }
| left=expr SLASH S* right=expr
{ Binop (left, "/", right) }
| op=unary_operator n=NUMBER S*
{ Unop (op, Number n) }
| op=unary_operator v=UNIT_VALUE S*
{ let (n, u) = v in Unop (op, Unit (n, u)) }
| n=NUMBER S*
{ Number n }
| v=UNIT_VALUE S*
{ let (n, u) = v in Unit (n, u) }
| str=STRING S*
{ Strlit str }
| id=IDENT S*
{ Ident id }
| uri=URI S*
{ Uri uri }
| fn=FUNCTION S* args=separated_list(COMMA, terminated(expr, S*)) RPAREN S*
{ Function (fn, args) }
| hex=HASH S*
{ if Str.string_match (Str.regexp "\\d{3}\\d{3}?") hex 0
then Hexcolor hex
else raise (SyntaxError ("invalid color #" ^ hex)) }
stringify.ml
View file @ 5c088307
......@@ -9,40 +9,52 @@ let rec cat sep fn = function
| [hd] -> fn hd
| hd :: tl -> fn hd ^ sep ^ cat sep fn tl
let rec value2str = function
| Lit lit -> lit
| Str str -> "\"" ^ str ^ "\""
| Lst values -> cat " " value2str values
| Dim (x, u) when float_of_int (int_of_float x) = x ->
string_of_int (int_of_float x) ^ u
| Dim (x, u) -> string_of_float x ^ u
| Fn (name, arg) -> name ^ "(" ^ value2str arg ^ ")"
| Imp -> "!important"
let prop2str (name, value) = name ^ ": " ^ value2str value ^ ";"
let string_of_num n =
if float_of_int (int_of_float n) = n
then string_of_int (int_of_float n)
else string_of_float n
let rec string_of_value = function
| Ident id -> id
| Strlit str -> "\"" ^ str ^ "\""
| Uri uri when String.contains uri ')' -> "url(\"" ^ uri ^ "\")"
| Uri uri -> "url(" ^ uri ^ ")"
| Concat values -> cat " " string_of_value values
| Number n -> string_of_num n
| Unit (n, u) -> string_of_num n ^ u
| Function (name, args) -> name ^ "(" ^ cat "," string_of_value args ^ ")"
| Hexcolor hex -> "#" ^ hex
| Unop (op, opnd) -> op ^ string_of_value opnd
| Binop (left, op, right) -> string_of_value left ^ op ^ string_of_value right
| Prio value -> string_of_value value ^ " !important"
let string_of_declaration (name, value) =
name ^ ": " ^ string_of_value value ^ ";"
let block body = " {\n" ^ indent body ^ "\n}"
let rec decl2str = function
| Group (selectors, props) ->
cat ", " (String.concat " ") selectors ^ block (cat "\n" prop2str props)
| Media (queries, groups) ->
"@media " ^ String.concat ", " queries ^ block (cat "\n\n" decl2str groups)
let rec string_of_statement = function
| Ruleset (selectors, decls) ->
cat ", " (String.concat " ") 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 ^ ";"
| Charset charset ->
"@charset \"" ^ charset ^ "\";"
| Page (None, props) ->
"@page" ^ block (cat "\n" prop2str props)
| Page (Some query, props) ->
"@page " ^ query ^ block (cat "\n" prop2str props)
| Fontface props ->
"@font-face " ^ block (cat "\n" prop2str props)
| Page (None, decls) ->
"@page" ^ block (cat "\n" string_of_declaration decls)
| Page (Some pseudo, decls) ->
"@page :" ^ pseudo ^ block (cat "\n" string_of_declaration decls)
| Fontface decls ->
"@font-face " ^ block (cat "\n" string_of_declaration decls)
| Namespace (None, uri) ->
"@namespace \"" ^ uri ^ "\";"
| Namespace (Some prefix, uri) ->
"@namespace " ^ prefix ^ " \"" ^ uri ^ "\";"
let decls2str = cat "\n\n" decl2str
let string_of_stylesheet = cat "\n\n" string_of_statement
types.ml
View file @ 5c088307
type value =
| Lit of string
| Str of string
| Lst of value list
| Dim of float * string
| Fn of string * value
| Imp
| Ident of string
| Strlit of string
| Uri of string
| Concat of value list
| Number of float
| Unit of float * string
| Function of string * value list
| Hexcolor of string
| Unop of string * value
| Binop of value * string * value
| Prio of value
type prop = string * value
type declaration = string * value
type selector = string list
type decl =
| Group of selector list * prop list (* <selectors> { <props> } *)
| Media of string list * decl list (* @media <queries> { <groups> } *)
| Import of string * string list (* @import "<file>" [<media>]; *)
| Charset of string (* @charset "<charset>"; *)
| Page of string option * prop list (* @page [<query>] { <props> } *)
| Fontface of prop list (* @font-face { <props> } *)
| Namespace of string option * string (* @namespace [<prefix>] "<uri>"; *)
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>]; *)
| Charset of string
(* @charset "<charset>"; *)
| Page of string option * declaration list
(* @page [<pseudo_page>] { <declarations> } *)
| Fontface of declaration list
(* @font-face { <declarations> } *)
| Namespace of string option * string
(* @namespace [<prefix>] "<uri>"; *)
(* TODO: @document, @keyframes, @supports *)
type stylesheet = statement list
type args = {
mutable infiles : string list;
mutable outfile : string option;
......@@ -28,4 +42,6 @@ type args = {
type loc = string * int * int * int * int
exception SyntaxError of string
exception LocError of loc * string
util.ml
View file @ 5c088307
......@@ -23,7 +23,7 @@ let input_buffered ic chunksize =
read_all (String.create chunksize) chunksize 0
let output_css oc decls =
output_string oc (Stringify.decls2str decls);
output_string oc (Stringify.string_of_stylesheet decls);
output_char oc '\n'
let print_css = output_css stdout
......
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